'===========================================================================
' Subject: GAMISH FONT IN MODE 13H            Date: 09-29-97 (20:20)       
'  Author: The ABC Programmer                 Code: PB                     
'  Origin: voxel@freenet.edmonton.ab.ca     Packet: PB.ABC
'===========================================================================
'************************************************
' GAMISH FONT in Mode 13h (320x200x256)
' Most routines converted from Pascal code to PB
' 100% Public Domain, use and abuse at risk.
'************************************************

%dither=2 ' 0 through 5
'DIM ABSOLUTE scrn?(32000) AT &HA000
'DIM ABSOLUTE scrn2?(32000) AT &HA7d0
DIM FOFS AS WORD, FSEG AS WORD, Addr AS WORD
DIM x as word,y as word
DIM Txt as STRING

Shared FOfs,FSeg,Vseg

Mode13h
InitPalette
GetFont

'FOR N=1 to 32000
'  Scrn?(N)=N MOD 255
'next N
'FOR N=1 to 32000
'  Scrn2?(N)=N MOD 255
'next N

Txt="Nothing special, looks gamish though!"
x=5:y=10
WriteTxt 1,x,y,Txt,37
Txt="Not Programmed by William Yu :)"
WriteTxt 0,10,50,Txt,78

a$=input$(1)
Def seg=&Ha000
FOR N=1 to 64000
  POKE N,0
NEXT N
TextMode
?"Please use and distribute freely!"
END

SUB WriteTxt(Text?, X as word, Y as word, Txt as String,Colour?)
'********************************************************************
' Function: Output text in Mode13h, GetFont MUST be called first!
'           And Mode13h, but geez, I don't need to tell you that :)
'   Inputs: Text?   - 1 - Gamish text, 0 - Normal text
'           X,Y     - Coordinates, in pixels, to place text at
'           Txt     - Your text
'           Colour? - Colour of text
'********************************************************************
DIM i as byte,j as byte,k as byte
DIM Addr AS Word
  for i=1 to len(txt)
    for j=0 to 15
      for k=0 to 7
        def seg=fseg
        Addr=PEEK(fofs+asc(mid$(txt,i,1))*16+j)
        SHIFT LEFT Addr,K
        if (Addr AND 128) <> 0 then
           DEF SEG=&HA000
           POKE (y+j+1)*320+(i*8)+x+k+1,0
           IF Text?=1 THEN  ' Cool gamish text
             POKE(y+j)*320+(i*8)+x+k,Colour?-j-k+RND*(2*%dither)
           ELSE            ' Normal coloured text
             POKE(y+j)*320+(i*8)+x+k,Colour?
           END IF
        end if
      next k
    next j
  next i
END SUB

SUB InitPalette
DIM St as byte, R as byte,G as byte, B as byte
  St=0
  FOR N=0 to 3*28-1 STEP 3
    READ R,G,B
    SetPal 16+St,R,G,B
    St=St+1
  NEXT N
  St=0
  FOR N=0 to 3*28-1 STEP 3
    READ R,G,B
    SetPal 50+St,R,G,B
    St=St+1
  NEXT N
END SUB

SUB TextMode
  ! mov AX, &h3
  ! int &h10
END SUB

SUB Mode13h
  ! mov AX, &H13
  ! Int &h10
END SUB

SUB GetFont
  ! push bp
  ! mov ax,&H1130
  ! mov bh,6
  ! int &H10
  ! mov fseg,es
  ! mov fofs,bp
  ! pop bp
END SUB

SUB SetPal(C?,R?,G?,B?)
  OUT &H3C8, C?
  OUT &H3C9, R?
  OUT &H3C9, G?
  OUT &H3C9, B?
END SUB

' Whatever, everything you see has been stolen <g>
DATA    4,4,2,8,8,4,12,12,6,16,16,8,20,20,10,24,24,12,28,28,14,32,32,16
DATA    36,36,18,40,40,20,44,44,22,48,48,24,52,52,26,52,52,26,56,56,28
DATA    56,56,28,60,60,30,60,60,30,60,60,30,63,63,33,63,63,33,63,63,33
DATA    63,63,33,63,63,33,60,60,30,56,56,28,52,52,26,48,48,24
DATA    4,2,2,8,4,4,12,6,6,16,8,8,20,10,10,24,12,12,28,14,14,32,16,16,
DATA    36,18,18,40,20,20,44,22,22,48,24,24,52,26,26,52,26,26,56,28,28,
DATA    56,28,28,60,30,30,60,30,30,60,30,30,63,33,33,63,33,33,63,33,33,
DATA    63,33,33,63,33,33,60,30,30,56,28,28,52,26,26,48,24,24