'===========================================================================
' Subject: CONVERT GRAPHICS IMAGE TO ASCII    Date: 09-30-99 (09:26)       
'  Author: David Karlov                       Code: QB, QBasic, PDS        
'  Origin: davidk@aurema.com                Packet: DEMOS.ABC
'===========================================================================
' PIC2BMP.BAS (incomplete)
' David Karlov    dkarlov@rocketmail.com
'                 dkarlov@acacia.itd.uts.edu.au
'                 davidk@softway.com.au
'
' (BmpLoad() and GifLoad() were not coded by me).

'------------------------------------------
' Converts graphical images to ascii art.

' This is a real hodge-podge of routines... It's currently not really
' usable unless you're a programmer.  If u r, feel free to examine the
' source code in detail... it's the only way you'll understand it ;)
'
' The core routine is ConvertPic().  It converts a rectangular area of
' the screen (in mode 8) to the "best fit" ascii text it can find.
' Functions GIF2TXT() and BMP2TXT() convert straight from a .GIF or .BMP
' to ascii art.
' Pics with a lot of contrast work best.
'
' There are also various routines for ascii animation... eg, for use in
' text email: "hold down the page down key..."
' Only 5 so far:
' name:     description:
' Hello     draws an animated wavy "hello" in big letters
' Spiral    a turning spiral, to hypnotize ppl via email
' Net       an attempt to draw 3d animation in a text file (a bit sad)
' Bloom     a lovely flower growing out of the ground
' Trail     a comet zipping all around the screen with fragmented tail
'
' If u want any more, it's basically code your own (for now..).. possibly
' a (limited) user-friendly interface on the way...
' Extended length animations can be made from those that cycle (eg Net, Hello,
' Spiral) by copying to append the first file u create. ("copy /?" for help)

TYPE FlowerType
   Tallness AS SINGLE
   LeafSpread AS SINGLE
   HeadSize AS SINGLE
   PetalSpread AS SINGLE
END TYPE

TYPE Pnt
   x AS INTEGER
   y AS INTEGER
END TYPE


DEFINT A-Z

' These 2 functions convert straight from a graphics format to ascii art.
DECLARE SUB BMP2TXT (FileName$)
DECLARE SUB GIF2TXT (FileName$)

DECLARE SUB Init ()
DECLARE SUB ConvertPic (x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER)
DECLARE FUNCTION GetRatio! (Char() AS INTEGER, Num AS INTEGER)
DECLARE SUB Col2BW (x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER)
DECLARE SUB GifLoad (A$)
DECLARE SUB BmpLoad (A$)

DECLARE SUB DrawNet (d AS INTEGER)
DECLARE SUB DrawSpiral (deg AS INTEGER)
DECLARE SUB DrawHello ()
DECLARE SUB RippleHello (d AS INTEGER)
DECLARE SUB DrawTrail ()
DECLARE SUB DrawLightning ()

DECLARE SUB InitFlower ()
DECLARE SUB GrowFlower (n AS INTEGER)



CONST PI = 3.141593

CONST NumWeight = 1  ' extra weight for each mismatched pixel.
CONST Index = 2   ' index of weight for increased distance.
CONST Scaling = 0 ' +ve means be relaxed about adding extra pixels,
                  ' -ve means be relaxed about leaving out some.
                  ' Range: -20 to 20.
CONST Density = 1   ' proportion of solid colour to plot when converting
                     ' colour images

' Intensities for different colour components.
CONST I.Red = .299
CONST I.Green = .587
CONST I.Blue = .144

' $DYNAMIC

DIM SHARED RA1 AS SINGLE
DIM SHARED RA2 AS SINGLE
DIM SHARED p(80, 80) AS SINGLE

DIM SHARED Flower(30) AS FlowerType
DIM SHARED Ground(16000) AS INTEGER
DIM SHARED Bloom AS INTEGER
DIM SHARED Grounds$

CONST TrailLen = 20
CONST sp1 = 35
DIM SHARED Trail(1 TO TrailLen, 1 TO 2) AS SINGLE
DIM SHARED cc AS INTEGER, cd AS INTEGER
FOR t = 1 TO TrailLen: Trail(t, 1) = -15 - 3 * t: Trail(t, 2) = 50 - 3 * t: NEXT t
cd = 1


DEF FNX1 (x, y) = 250 + RA1 * (y - x)
DEF FNY1 (x, y) = 130 - RA2 * (x + y) - p(x, y)


'$DYNAMIC
DIM SHARED Pic(20002) AS INTEGER
DIM SHARED Pal(0 TO 255, 0 TO 2) AS INTEGER
DIM SHARED CharImg(0 TO 64 * 96 - 1) AS INTEGER
DIM SHARED PlusW AS SINGLE, SubW AS SINGLE
DIM SHARED f$

DIM SHARED hello(0 TO 10241) AS INTEGER

DIM SHARED SetNumLines
SetNumLines = 0   ' Set this to n if the outputted text must contain
                  ' exactly n lines. (Useful for scrolling animations).

ON KEY(10) GOSUB quit1
KEY(10) ON


Init


' pick your GOTO.....

'GOTO hello
'GOTO spiral
'GOTO net
'GOTO Bloom
GOTO Trail

' .... or Hack in this space:




SCREEN 13: CLS
'GIF2TXT "\pics\perr.gif"
BMP2TXT "\qb\qbpaint\jinx.bmp"

END


hello:
SetNumLines = 17  ' the right amount for sending to ppl who use pine (i think)
SCREEN 8: CLS
DrawHello
FOR d = 0 TO 359 STEP 20
   CLS
   RippleHello d
   ConvertPic 0, 0, 383, 150
   OPEN "hello" + LTRIM$(RTRIM$(STR$(d \ 20))) + ".txt" FOR OUTPUT AS #1
   PRINT #1, f$
   CLOSE #1
NEXT d
SHELL "copy hello0.txt hello.txt"
FOR t = 1 TO 17
   c$ = "copy /A hello.txt + " + "hello" + LTRIM$(RTRIM$(STR$(t))) + ".txt" + " hello.txt"
   PRINT c$
   SHELL c$
NEXT t
PRINT "hello.txt is complete."
END

spiral:
SetNumLines = 17
SCREEN 8: CLS
FOR d = 0 TO 359 STEP 20
   CLS
   DrawSpiral d
   ConvertPic 0, 0, 631, 199
   OPEN "spiral" + LTRIM$(RTRIM$(STR$(d \ 20))) + ".txt" FOR OUTPUT AS #1
   PRINT #1, f$
   CLOSE #1
NEXT d
SHELL "copy spiral0.txt spiral.txt"
FOR t = 1 TO 17
   c$ = "copy /A spiral.txt + " + "spiral" + LTRIM$(RTRIM$(STR$(t))) + ".txt" + " spiral.txt"
   PRINT c$
   SHELL c$
NEXT t
PRINT "spiral.txt is complete."
END


net:
SetNumLines = 17
SCREEN 8: CLS
FOR d = 0 TO 359 STEP 20
   OPEN "net" + LTRIM$(RTRIM$(STR$(d \ 20))) + ".txt" FOR BINARY AS #1
   IF LOF(1) = 0 THEN
      CLOSE #1
      CLS
      DrawNet d
      ConvertPic 0, 0, 600, 199
      OPEN "net" + LTRIM$(RTRIM$(STR$(d \ 20))) + ".txt" FOR OUTPUT AS #1
      PRINT #1, f$
   END IF
   CLOSE #1
NEXT d
SHELL "copy net0.txt net.txt"
FOR t = 1 TO 17
   c$ = "copy /A net.txt + " + "net" + LTRIM$(RTRIM$(STR$(t))) + ".txt" + " net.txt"
   PRINT c$
   SHELL c$
NEXT t
PRINT "net.txt is complete."
END


Bloom:

Bloom = 1

InitFlower
FOR t = 1 TO 27
   OPEN "bloom" + LTRIM$(RTRIM$(STR$(t))) + ".txt" FOR BINARY AS #1
   IF LOF(1) = 0 THEN
      CLOSE #1
      CLS
      GrowFlower t
      ConvertPic 0, 0, 400, 149
      OPEN "bloom" + LTRIM$(RTRIM$(STR$(t))) + ".txt" FOR OUTPUT AS #1
      PRINT #1, f$
   END IF
   CLOSE #1
NEXT t
'STOP
SHELL "copy bloom1.txt bloom.txt"
FOR t = 2 TO 27
   c$ = "copy /A bloom.txt + " + "bloom" + LTRIM$(RTRIM$(STR$(t))) + ".txt" + " bloom.txt"
   PRINT c$
   SHELL c$
NEXT t
PRINT "bloom.txt is complete."
END


Trail:
' Continues generating until a key is pressed.
'SetNumLines = 17
SCREEN 8
t = 0
DO
   t = t + 1
   CLS
   LOCATE 25, 1: PRINT t;
   DrawTrail
   ConvertPic 0, 0, 600, 136
   OPEN "trail" + LTRIM$(RTRIM$(STR$(t))) + ".txt" FOR OUTPUT AS #1
   PRINT #1, f$
   CLOSE #1
   IF t = 1 THEN
      SHELL "copy trail1.txt trail.txt"
   ELSE
      SHELL "copy /A trail.txt + " + "trail" + LTRIM$(RTRIM$(STR$(t))) + ".txt" + " trail.txt"
   END IF
LOOP
STOP
END


quit1:
END

REM $STATIC
SUB BMP2TXT (A$)

SCREEN 13: CLS
BmpLoad A$
Col2BW 0, 0, 319, 199
ConvertPic 0, 0, 631, 199

t = INSTR(A$, ".")
IF t THEN A$ = LEFT$(A$, t - 1)

OPEN A$ + ".TXT" FOR OUTPUT AS #1
PRINT #1, f$
CLOSE #1


END SUB

SUB BmpLoad (A$)

DIM imagesize AS LONG

FileName$ = A$
IF INSTR(FileName$, ".") = 0 THEN FileName$ = FileName$ + ".BMP"
OPEN FileName$ FOR BINARY AS #1

header$ = SPACE$(14)
sizing$ = SPACE$(4)
GET #1, 1, header$
GET #1, 15, sizing$
bmpinfosize = CVI(sizing$)
'bmpinfosize - Is the size of the information header for the bitmap.
'              Different bitmap versions have variations in filetypes.
'              40 is a standard windows 3.1 bitmap.
'              12 is for OS/2 bitmaps
'The next routine reads in the appropriate headers and colour tables.
'nbits is the number of bits per pixel - i.e. number of colours
'1 bit = 2 colours, 4 bits = 16 colours, 8 bits = 256 colours, etc.
'the 24 bit mode does not have a palette, its colours are expressed as
'image data

'Design of a windows 3.1 bitmap - Taken from bmp.zip on the
'x2ftp.oulu.fi ftp site under /pub/msdos/programming/formats
'Specifications for a Windows 3.1 bitmap. (.BMP)
'Email any questions/responses to me at zabudsk@ecf.utoronto.ca
'or post to alt.lang.basic or comp.lang.basic.misc.

'       | # of   |
'Offset | bytes  | Function (value)
'-------+--------+--- General Picture information starts here---------
'  0    |   2    | (BM) - Tells us that the picture is in bmp format
'  2    |   4    | Size of the file (without header?)
'  6    |   2    | (0) Reserved1 - Must be zero
'  8    |   2    | (0) Reserved2 - Must be zero
'  10   |   4    | Number of bytes offset of the picture data
'-------+--------+--- Information Header starts here -----------------
'  14   |   4    | (40/12) Size of information header (Win3.1/OS2)
'  18   |   4    | Picture width in pixels
'  22   |   4    | Picture Height in pixels
'  26   |   2    | (1) Number of planes, must be 1
'  28   |   2    | Number of bits per pixel (bpp), must be 1,4,8 or 24
'  30   |   4    | (0) Compression - 0 means no compression, 1,2 are RLEs
'  34   |   4    | Image size in bytes
'  38   |   4    | picture width in pels per metre
'  42   |   4    | picture height in pels per metre
'  46   |   4    | (0) Number of colours used in the picture, 0 means all
'  50   |   4    | (0) Number of important colours, 0 means all
'-------+--------+--- Palette data starts here -----------------------
'  54   |   1    | (b) - blue intensity component, color 0 - range 0 to 255
'  55   |   1    | (g) - green intensity component, color 0 - range 0 to 255
'  56   |   1    | (r) - red intensity component, color 0 - range 0 to 255
'  57   |   1    | (0) - unused
'  58   |   1    | (b) - blue intensity component, color 0 - range 0 to 255
'  ...  | ...    |
'  54   | 4*2^bpp| total range of palette
'-------+--------+--- Image data starts here -------------------------
'54+    | width* | Bitmap data starting at lower left portion of the
'(4*2^n)| height*| image moving from left towards right. Moving up 1
'       | (8/bpp)| pixel when at the right hand side of the image, starting
'       |        | from the left side again, until the top right of the
'       |        | image is reached

'Note that this format is slightly different for a OS/2 Bitmap.
'The header is the same up to (but not including) bit 30-
'The palette colour values follow at bit 30, with the form...
'1 byte blue intensity
'1 byte green intensity
'1 byte red intensity
'For each colour of the picture.
'Bitmapped image data follows the colour tables


'Special note: When storing 1 bit (2 colour) pictures.
'8 horizontal pixels are packed into 1 byte. Each bit determines
'the colour of one pixel (colour 0 or colour 1)

'4 bit pictures (16 colours) use 2 nibbles (4 bits) for each pixel
'thus there are 2 pixels for each byte of image data.

'8 bit pictures use 1 byte per pixel. Each byte of image data
'represents one of 256 colours.

'24 bit pictures express colour values by using 3 bytes and each has a
'value between 0 and 255. The first byte is for red, the second is for
'green and the third is for blue. Thus (256)^3 or 2^24 of 16777216 different
'colours.

IF bmpinfosize = 12 THEN
   infoheader$ = SPACE$(12)
   GET #1, 15, infoheader$
   nbits = CVI(MID$(infoheader$, 15, 4))
 
   IF nbits = 1 THEN
      palet$ = SPACE$(6)
      GET #1, bmpinfosize + 15, palet$
   ELSEIF nbits = 4 THEN
      palet$ = SPACE$(48)
      GET #1, bmpinfosize + 15, palet$
   ELSEIF nbits = 8 THEN
      palet$ = SPACE$(768)
      GET #1, bmpinfosize + 15, palet$
   END IF
ELSEIF bmpinfosize = 40 THEN
   infoheader$ = SPACE$(40)
   GET #1, 15, infoheader$
   nbits = CVI(MID$(infoheader$, 15, 4))
   IF nbits = 1 THEN
      palet$ = SPACE$(8)
      GET #1, bmpinfosize + 15, palet$
   ELSEIF nbits = 4 THEN
      palet$ = SPACE$(64)
      GET #1, bmpinfosize + 15, palet$
   ELSEIF nbits = 8 THEN
      palet$ = SPACE$(1024)
      GET #1, bmpinfosize + 15, palet$
   END IF
END IF
    

FT$ = MID$(header$, 1, 2)
'PRINT "Type of file (Should be BM): "; ft$

filesize = CVL(MID$(header$, 3, 4))
'PRINT "Size of file: "; filesize

r1 = CVI(MID$(header$, 7, 2))
'PRINT "Reserved 1: "; r1

r2 = CVI(MID$(header$, 9, 2))
'PRINT "Reserved 2: "; r2

offset = CVL(MID$(header$, 11, 4))
'PRINT "Number of bytes offset from beginning: "; offset

'PRINT

headersize = CVL(MID$(infoheader$, 1, 4))
'PRINT "Size of header: "; headersize

picwidth = CVL(MID$(infoheader$, 5, 4))
'PRINT "Width: "; picwidth
'
picheight = CVL(MID$(infoheader$, 9, 4))
'PRINT "Height: "; picheight

nplanes = CVI(MID$(infoheader$, 13, 4))
'PRINT "Planes: "; nplanes

'PRINT "Bits per plane: "; nbits

'PRINT

IF headersize = 40 THEN
'   PRINT "Compression: ";
   comptype = CVL(MID$(infoheader$, 17, 4))
'   IF comptype = 0 THEN PRINT "None"
'   IF comptype = 1 THEN PRINT "Run Length - 8 Bits"
'   IF comptype = 2 THEN PRINT "Run Length - 4 Bits"
 
   imagesize = CVL(MID$(infoheader$, 21, 4))
'   PRINT "Image Size (bytes): "; imagesize
 
   xsize = CVL(MID$(infoheader$, 25, 4))
'   PRINT "X size (pixels per metre): "; xsize
 
   ysize = CVL(MID$(infoheader$, 29, 4))
'   PRINT "Y size (pixels per metre): "; ysize
 
   colorsused = CVL(MID$(infoheader$, 33, 4))
'   PRINT "Number of colours used: "; colorsused
 
   neededcolours = CVL(MID$(infoheader$, 37, 4))
'   PRINT "Number of important colours: "; neededcolours
END IF
'PRINT
'PRINT "Press Any key to continue."
'WHILE INKEY$ = ""
'WEND

IF nbits = 1 THEN
   SCREEN 11
ELSEIF nbits = 4 THEN
   SCREEN 12
ELSEIF nbits = 8 OR nbits = 24 THEN
   SCREEN 13
END IF
IF bmpinfosize = 40 THEN ngroups = 4
IF bmpinfosize = 12 THEN ngroups = 3

IF nbits = 24 THEN
   IF ngroups = 3 THEN
      FOR c = 0 TO 63
         d = c * 4
         palet$ = palet$ + CHR$(d) + CHR$(d) + CHR$(d)
         palet$ = palet$ + CHR$(d) + CHR$(d) + CHR$(d + 1)
         palet$ = palet$ + CHR$(d) + CHR$(d + 1) + CHR$(d)
         palet$ = palet$ + CHR$(d + 1) + CHR$(d) + CHR$(d)
      NEXT c
   ELSEIF ngroups = 4 THEN
      FOR c = 0 TO 63
         d = c * 4
         palet$ = palet$ + CHR$(d) + CHR$(d) + CHR$(d) + CHR$(0)
         palet$ = palet$ + CHR$(d) + CHR$(d) + CHR$(d + 1) + CHR$(0)
         palet$ = palet$ + CHR$(d) + CHR$(d + 1) + CHR$(d) + CHR$(0)
         palet$ = palet$ + CHR$(d + 1) + CHR$(d) + CHR$(d) + CHR$(0)
      NEXT c
   END IF
END IF

FOR x = 1 TO LEN(palet$) STEP ngroups
   zb# = INT((ASC(MID$(palet$, x, 1))) / 4)
   zg# = INT((ASC(MID$(palet$, x + 1, 1))) / 4)
   zr# = INT((ASC(MID$(palet$, x + 2, 1))) / 4)
   Pal(x \ ngroups, 0) = zr#
   Pal(x \ ngroups, 1) = zg#
   Pal(x \ ngroups, 2) = zb#
   zc# = zb# * 65536# + zg# * 256# + zr#
   cres = ASC(MID$(palet$, x + 3, 1))
   PALETTE ((x - 1) / ngroups), zc#
NEXT x

IF nbits = 24 THEN
   y = picheight - 1
   x = 0
   dat$ = "   "
   WHILE y >= 0
      WHILE x < picwidth
         GET 1, , dat$
         P1 = INT((ASC(MID$(dat$, 1, 1)) + ASC(MID$(dat$, 1, 1)) + ASC(MID$(dat$, 1, 1))) / 3)
         PSET (x, y), P1
         x = x + 1
      WEND
      y = y - 1
      x = 0
   WEND
ELSEIF nbits = 8 THEN
   y = picheight - 1
   x = 0
   dat$ = " "
   WHILE y >= 0
      WHILE x < picwidth
         GET 1, , dat$
         PSET (x, y), ASC(dat$)
         x = x + 1
      WEND
      y = y - 1
      x = 0
   WEND
ELSEIF nbits = 4 THEN
   y = picheight - 1
   x = 0
   dat$ = " "
   WHILE y >= 0
      WHILE x < picwidth
        GET 1, , dat$
        LOCATE 1, 1
        P1 = ASC(dat$) AND 15
        p2 = ASC(dat$) AND 240 / 16
        PSET (x, y), P1
        PSET (x + 1, y), p2
        x = x + 2
      WEND
      y = y - 1
      x = 0
   WEND
ELSEIF nbits = 1 THEN
   y = picheight - 1
   x = 0
   dat$ = " "
   WHILE y >= 0
      WHILE x < picwidth
        GET 1, , dat$
        P1 = ASC(dat$)
        FOR p = 0 TO 7
           PSET (x + (7 - p), y), (P1 AND 2 ^ p) / 2 ^ p
        NEXT p
        x = x + 8
      WEND
      y = y - 1
      x = 0
   WEND
END IF

CLOSE #1


END SUB

SUB Col2BW (x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER)
' Transforms a screen 13 colour image into a screen 8 monochrome image.
' Each pixel of the colour image is processed into 2 pixels side by side
' in the monochrome image.
' The final screen 8 image will be twice as wide in pixels as the original
' screen 13 image, but the same "screen width".

' Assumption: The image is already on the screen when Col2BW is called.
'             The palette used is stored in Pal().

DIM Intensities(0 TO 255) AS SINGLE
DIM TempImg(0 TO (x2 - x1 + 3) \ 4, 0 TO y2 - y1) AS INTEGER
DIM Powers2(0 TO 7)
Powers2(0) = 1: Powers2(1) = 2: Powers2(2) = 4: Powers2(3) = 8
Powers2(4) = 16: Powers2(5) = 32: Powers2(6) = 64: Powers2(7) = 128

FOR t = 0 TO 255
   Intensities(t) = (Pal(t, 0) * I.Red + Pal(t, 1) * I.Green + Pal(t, 2) * I.Blue) / 64 * Density
NEXT t

FOR x = x1 TO x2
   FOR y = y1 TO y2
      IF RND <= Intensities(POINT(x, y)) THEN
         TempImg((x - x1) \ 4, y - y1) = TempImg((x - x1) \ 4, y - y1) + Powers2(2 * ((x - x1) MOD 4))
      END IF
      IF RND <= Intensities(POINT(x, y)) THEN
         TempImg((x - x1) \ 4, y - y1) = TempImg((x - x1) \ 4, y - y1) + Powers2(2 * ((x - x1) MOD 4) + 1)
      END IF
   NEXT y
NEXT x

SCREEN 8: CLS

FOR x = x1 TO x2
   FOR y = y1 TO y2
      PSET (2 * (x - x1) + x1, y - y1), SGN(TempImg((x - x1) \ 4, y - y1) AND Powers2(2 * ((x - x1) MOD 4))) * 15
      PSET (2 * (x - x1) + x1 + 1, y - y1), SGN(TempImg((x - x1) \ 4, y - y1) AND Powers2(2 * ((x - x1) MOD 4) + 1)) * 15
   NEXT y
NEXT x


END SUB

SUB ConvertPic (x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER)

DIM TempChar(0 TO 63) AS INTEGER
DIM Ratios(32 TO 126) AS SINGLE
DIM BestRat AS SINGLE

f$ = ""

pn = 1

COLOR 15

FOR y = y1 \ 8 TO y2 \ 8
  
   IF y = 16 AND Bloom = 1 AND Grounds$ <> "" THEN
      LOCATE 17, 1: PRINT Grounds$;
      f$ = f$ + Grounds$
   ELSE
      IF y = 16 THEN G2$ = ""

      FOR x = x1 \ 8 TO x2 \ 8
'        LOCATE 25, 1: PRINT x; y; "   ";
         pn = pn + 1
         Nump = 0
         FOR XX = 0 TO 7: FOR YY = 0 TO 7
            TempChar(XX + YY * 8) = SGN(POINT(XX + x * 8, YY + y * 8))
            IF TempChar(XX + YY * 8) = 1 THEN Nump = Nump + 1
         NEXT YY: NEXT XX

         IF Nump > 1 THEN
            BestRat = 9E+30: BestNum = 32
            FOR t = 32 TO 126
               Ratios(t) = GetRatio!(TempChar(), t)
               IF Ratios(t) <= BestRat THEN BestRat = Ratios(t): BestNum = t
               IF BestRat = 0 THEN EXIT FOR
            NEXT t
         ELSE
            BestNum = 32
         END IF

         LOCATE y + 1, x + 1: PRINT CHR$(BestNum);
'        LOCATE 24, 1: PRINT BestRat;
         f$ = f$ + CHR$(BestNum)
         IF y = 16 THEN G2$ = G2$ + CHR$(BestNum)
         IF BestNum = 32 THEN NumSpac = NumSpac + 1 ELSE NumSpac = 0

      NEXT x

      IF y = 16 AND Grounds$ = "" THEN Grounds$ = G2$

   END IF

   ' remove trailing space characters
   IF NumSpac THEN f$ = LEFT$(f$, LEN(f$) - NumSpac): NumSpac = 0
   f$ = f$ + CHR$(10) + CHR$(13)
NEXT y

EXIT SUB


' remove all trailing blank lines except 1
DO UNTIL RIGHT$(f$, 4) <> CHR$(10) + CHR$(13) + CHR$(10) + CHR$(13)
   f$ = LEFT$(f$, LEN(f$) - 2)
LOOP

'***DON'T***  remove all leading blank lines
'DO UNTIL LEFT$(f$, 2) <> CHR$(10) + CHR$(13)
'   f$ = RIGHT$(f$, LEN(f$) - 2)
'LOOP

NL = 0
FOR t = 1 TO LEN(f$)
   IF MID$(f$, t, 1) = CHR$(13) THEN NL = NL + 1
NEXT t

IF SetNumLines THEN
   FOR t = 1 TO SetNumLines - NL - 1
      f$ = f$ + CHR$(10) + CHR$(13)
   NEXT t
END IF


END SUB

SUB DrawHello

DIM Temp(47, 7) AS INTEGER

SCREEN 8: CLS
PRINT "HELLO!"
FOR x = 0 TO 47: FOR y = 0 TO 7
   Temp(x, y) = SGN(POINT(x, y))
NEXT y: NEXT x
CLS

FOR x = 0 TO 47: FOR y = 0 TO 7
   IF Temp(x, y) THEN LINE (x * 8, y * 8)-(x * 8 + 7, y * 8 + 7), 15, BF
NEXT y, x

GET (0, 0)-(383, 63), hello(0)
CLS

END SUB

SUB DrawLightning


''''''''''''''''''''''under construction


' If not the first frame, then load the previous frame from file.

SCREEN 8: CLS
'PALETTE 0, 0
'PALETTE 1, 0
'PALETTE 3, (65536 + 256 + 1) * 12

DIM H(639)

LR1 = .4
BM1 = 1.5

R7 = .6
R6 = .3
R9 = .9995
NS1 = 35: NS = NS1
DIM L(2, NS * 2)
R8 = .75
DE1 = 1: DE2 = 0
F1 = 20: F2 = 5
FAN = (F1 + F2) / 2

LINE (0, 0)-(639, 479), 1, BF
y1 = 360

IF DE2 = 0 THEN
   PSET (0, y1), 0
   FOR t = 1 TO 639
      DO UNTIL RND < LR1: y1 = y1 + RND * BM1 - RND * BM1: LOOP
      H(t) = y1
      LINE -(t, y1), 0
   NEXT t
ELSE
   FOR t = 0 TO 639
      H(t) = y1
   NEXT t: LINE (0, y1)-(639, y1), 0
END IF
PAINT (0, 479), 0

'PALETTE 1, 65793
'PALETTE 2, 4144959

'PSET ((639 / .025) * (1 - R9), 479), 3



DO
   IF RND > R9 THEN GOSUB L1

   IF LB > 1 THEN
      LB = LB - 1
      PALETTE 1, INT((LB * R8) / FAN * 63) * (65536 + 256 + 1)
      PALETTE 2, INT((LB + R8 - 1) / FAN * 63) * (65536 + 256 + 1)
   END IF
   IF LB > FAN / 2 AND SW8 = 1 AND RND > R7 THEN SW8 = 0: GOSUB L2

   IF LB = 1 THEN PALETTE 1, 65793: PALETTE 2, 65793: PAINT (0, 0), 1, 0: LB = 0

LOOP


L1:
NS = INT(NS1 * (.5 + RND))
x1 = INT(RND * 600) + 20: x2 = x1
YY = H(x1)
FOR t = NS - 1 TO 0 STEP -1
   y1 = YY / (NS - 1) * t
   x1 = x1 + RND * 10 - RND * 10
   L(1, t + 1) = x1
   L(2, t + 1) = y1
NEXT t
PSET (L(1, 1), 0), 2
x1 = x2
FOR t = 1 TO NS - 1
   LINE -(L(1, t + 1), L(2, t + 1)), 2
NEXT t

IF DE1 THEN GOSUB HOLE1


FAN = INT(RND * (F1 - F2) + F2)
IF LB > 0 THEN FAN = INT(FAN * 2 / 3)
LB = FAN
R8 = RND / 2 + .5
IF RND > R7 THEN SW8 = 1

RETURN

L2:

PSET (L(1, 1), 0), 1
IF RND > R6 THEN
   FOR t = 1 TO NS - 1
      LINE -(L(1, t + 1), L(2, t + 1)), 1
   NEXT t
END IF

CIP = INT(RND * NS * 3 / 4) + 1
x1 = L(1, CIP + 1)


FOR t = CIP - 1 TO NS - 1
   y1 = YY / (NS - 1) * t
   x1 = x1 + RND * 10 - RND * 10
   IF t = NS - 1 AND x1 >= 0 AND x1 <= 639 THEN y1 = H(x1)
   L(1, t + 1) = x1
   L(2, t + 1) = y1
NEXT t
   PSET (L(1, 1), 0), 2
FOR t = 1 TO NS - 1
   LINE -(L(1, t + 1), L(2, t + 1)), 2
NEXT t

IF DE1 THEN GOSUB HOLE1

FAN = INT(RND * (F1 - F2) + F2)
LB = FAN
R8 = RND / 2 + .5
IF RND > R7 THEN SW8 = 1

RETURN

HOLE1:
   IF x1 >= 0 AND x1 <= 639 THEN PSET (x1, H(x1)), 1: H(x1) = H(x1) - 1
RETURN



END SUB

SUB DrawNet (deg AS INTEGER)

SCREEN 8: CLS

DIM I1 AS LONG, I2 AS LONG
DIM XA AS SINGLE, XB AS SINGLE, XC AS SINGLE, XD AS SINGLE
DIM YA AS SINGLE, YB AS SINGLE, YC AS SINGLE, YD AS SINGLE
DIM D1 AS SINGLE


'I1 = 2 ^ (8 * INT(RND * 3))
'DO
'I2 = 2 ^ (8 * INT(RND * 3))
'LOOP UNTIL I2 <> I1
'65536 = blue, 256 = green, 1 = red
I1 = 0: I2 = 1 + 256 + 65536

' $DYNAMIC

'FOR T = 1 TO 14
'   PALETTE T, I1 * INT(4.5 * T) + I2 * (63 - INT(4.5 * T))
'NEXT T

SW1 = 1
B = 0   ' Draw tile border
s = 80  ' Size of array (S x S)
'DIM P(S, S)

'ON ERROR GOTO ER1


RA1 = 220 / s: RA2 = 50 / s


H = 18: n = 3

FOR x = 0 TO s: LOCATE 1, 1: PRINT USING "##"; (100 * x / s); : PRINT " %";
   FOR y = 0 TO s
      D1 = SQR((s / 2 - x) ^ 2 + (s / 2 - y) ^ 2) / s * SQR(2)
      p(x, y) = SIN(D1 * 16 + deg * PI / 180) * H
   NEXT y
NEXT x

CLS


'STOP

PLOT:
FOR t = 2 * s TO 2 STEP -1
   IF t > s THEN x1 = s ELSE x1 = t - 1
   x2 = t - x1: IF x2 < 1 THEN x2 = 1
   FOR x = x1 TO x2 STEP -1

      y = t - x

      IF p(x, y) = 0 AND p(x - 1, y) = 0 AND p(x - 1, y - 1) = 0 AND p(x, y - 1) = 0 THEN GOTO NB1
      XA = FNX1(x, y): XB = FNX1(x - 1, y): XC = FNX1(x - 1, y - 1): XD = FNX1(x, y - 1)
      YA = FNY1(x, y): YB = FNY1(x - 1, y): YC = FNY1(x - 1, y - 1): YD = FNY1(x, y - 1)
      IF SW1 = 1 AND B = 0 THEN XB = XB + 1: XD = XD - 1: YA = YA - 1: YC = YC + 1
      PSET (XA, YA), 15
      LINE -(XB, YB), 15
      LINE -(XC, YC), 15
      LINE -(XD, YD), 15
      LINE -(XA, YA), 15
      XX = (XB + XD) / 2
      YY = (YA + YC) / 2
      C91 = 0: GOSUB CHECK1
      IF FT = 2 THEN
         PAINT (XX, YY), 15, 15
       
         H1 = ABS(YC - YA)
         D1 = YD - YB
         C1 = H1 * 7 * s / 800
         C2 = (D1 * s) / 120 + 7
         c = (C1 + C2) / 2
       
         IF c < 1 THEN c = 1
         IF c > 14 THEN c = 14
      END IF
     
      PSET (XA, YA), c * (1 - B)
      LINE -(XB, YB), c * (1 - B)
      LINE -(XC, YC), c * (1 - B)
      LINE -(XD, YD), c * (1 - B)
      LINE -(XA, YA), c * (1 - B)
      IF FT = 2 THEN
         PAINT (XX, YY), c, c * (1 - B)
      END IF

'      WHILE INKEY$ = "": WEND

NB1:

   NEXT x
NEXT t

FOR x1 = 0 TO 500
   FOR y1 = 0 TO 199
      IF RND * 12 < POINT(x1, y1) - 2 THEN PSET (x1, y1), 7 ELSE PRESET (x1, y1)
   NEXT y1
NEXT x1

EXIT SUB




CHECK1:
   IF POINT(XX, YY) = 15 THEN FT = 0: RETURN
 
'   FOR TT1 = YY - 1 TO YY - 200 STEP -1
'     IF POINT(XX, TT1) = 15 THEN FT1 = TT1: EXIT FOR
'   NEXT TT1
'   FOR TT2 = YY + 1 TO YY + 200
'      IF POINT(XX, TT2) = 15 THEN FT2 = TT2: EXIT FOR
'   NEXT TT2
'   L9 = ABS(FT2 - FT1)

FT = 2
RETURN

'ER1:
'STOP


PAL1:
DO
I1 = 2 ^ (8 * INT(RND * 3))
I2 = 2 ^ (8 * INT(RND * 3))
K = 0
DO
K = K + 1
PALETTE K, I1 * INT(4.5 * K) + I2 * (63 - INT(4.5 * K))
LOOP UNTIL K = 14
PALETTE 0, INT(RND * 64) * 65536 + INT(RND * 64) * 256 + INT(RND * 64)
'PALETTE INT(RND * 14 + 1), INT(RND * 64) * 65536 + INT(RND * 64) * 256 + INT(RND * 64)
'WHILE INKEY$ = "": WEND
LOOP UNTIL INKEY$ <> ""



LL = 0
DO
DO
LL = LL + 1
PALETTE LL, INT(RND * 64) * 65536 + INT(RND * 64) * 256 + INT(RND * 64)
KK = 0: DO: KK = KK + 1: LOOP UNTIL KK = 20
PALETTE LL, 0
PALETTE 0, INT(RND * 64) * 65536 + INT(RND * 64) * 256 + INT(RND * 64)
LOOP UNTIL LL = 14
IF INKEY$ <> "" THEN GOTO PAL1
DO
LL = LL - 1
PALETTE LL, INT(RND * 64) * 65536 + INT(RND * 64) * 256 + INT(RND * 64)
KK = 0: DO: KK = KK + 1: LOOP UNTIL KK = 20
PALETTE LL, 0
PALETTE 0, INT(RND * 64) * 65536 + INT(RND * 64) * 256 + INT(RND * 64)
LOOP UNTIL LL = 1
LOOP UNTIL INKEY$ <> ""
GOTO PAL1

WRECK:
DO
LINE -(INT(RND * 840 - 100), INT(RND * 680 - 100)), INT(RND * 16)
LOOP


END SUB

REM $STATIC
SUB DrawSpiral (deg AS INTEGER)

NumTurns! = 1.5

FOR r = 0 TO 360
   th! = (NumTurns! * r + deg)
   thr! = th! * PI / 180
   r2! = r * .8
   FOR t = 1 TO 12
      x2! = RND * 4 - 2: y2! = RND * 4 - 2
      PSET (x2! + .6 * (320 + r2! * COS(thr!)), y2! + .8 * (100 + (r2! * SIN(thr!)) * 5 / 16)), 15
   NEXT t
   thr! = 2 * th! * PI / 180
   FOR t = 1 TO 20
      x2! = RND * 4 - 2: y2! = RND * 4 - 2
      PSET (x2! + .6 * (320 - r2! * COS(thr!)), y2! + .8 * (100 + (r2! * SIN(thr!)) * 5 / 16)), 15
   NEXT t
NEXT r

END SUB

SUB DrawTrail
' draws one further frame in the animation.

' shift trail by 1
FOR t = TrailLen - 1 TO 1 STEP -1
   Trail(t + 1, 1) = Trail(t, 1)
   Trail(t + 1, 2) = Trail(t, 2)
NEXT t

cc = (cc + 20 + cd) MOD 20
IF RND > .94 THEN cc = INT(RND * 20)
IF RND > .94 THEN cd = -cd

XX = 250 * COS(PI * cc / 10)
YY = 60 * SIN(PI * cc / 10)

x! = Trail(2, 1): y! = Trail(2, 2)
GOSUB MoveTrail

Trail(1, 1) = x! + x1! + .9 * (Trail(2, 1) - Trail(3, 1))
Trail(1, 2) = y! + y1! + .9 * (Trail(2, 2) - Trail(3, 2))



' draw trail
CLS
FOR t = TrailLen - 1 TO 1 STEP -1
   r! = t * 1.5 + 5

   IF t > 1 THEN
      x1 = Trail(t - 1, 1): x2 = Trail(t, 1)
      y1 = Trail(t - 1, 2): y2 = Trail(t, 2)
      FOR n! = 1 TO 50 + (TrailLen - t) * 10
         r1! = RND
         x0 = x1 + (x2 - x1) * r1!
         y0 = y1 + (y2 - y1) * r1!
         r1! = RND * r! * 1.5
         th! = RND * 2 * PI
         CIRCLE (x0 + r1! * COS(th!), y0 + r1! * SIN(th!)), RND, 0
      NEXT n!
   END IF

   x1 = Trail(t, 1): x2 = Trail(t + 1, 1)
   y1 = Trail(t, 2): y2 = Trail(t + 1, 2)
   FOR n! = 1 TO 15 + (TrailLen - t) * 3
      r1! = RND
      x0 = x1 + (x2 - x1) * r1!
      y0 = y1 + (y2 - y1) * r1!
      r1! = RND * r!
      th! = RND * 2 * PI
      CIRCLE (x0 + r1! * COS(th!), y0 + r1! * SIN(th!)), RND
   NEXT n!



NEXT t

EXIT SUB


MoveTrail:
x1! = (300 + XX - x!) / sp1
y1! = (68 + YY - y!) / sp1
RETURN

END SUB

FUNCTION GetRatio! (Char() AS INTEGER, Num AS INTEGER)
   ' Char() is 64 bit array of an 8x8 section of screen to convert to ascii.
   ' Num is the actual character we are comparing it with.

   m = 0 ' num. of bit matches
   t1 = 0 ' total num. of (non-black) pixels in 8x8 square
   t2 = 0 ' total num. of (non-black) pixels in real ascii char.
   n! = 0 ' no. of mismatches. (distance-scaled).
   N1 = (Num - 32) * 64
   FOR B = 0 TO 63
      ci! = CharImg(N1 + B)
      IF Char(B) <> ci! THEN
         Found = 0: Dist = 8
         x1 = B MOD 8
         y1 = B \ 8
         IF Char(B) = 1 THEN
            FOR r = 1 TO 7
               FOR XX = -r TO r
                  FOR YY = -r TO r
                     x2 = x1 + XX
                     y2 = y1 + YY
                     IF (XX <> 0 OR YY <> 0) AND (x2 >= 0 AND x2 <= 7 AND y2 >= 0 AND y2 <= 7) THEN
                        IF CharImg(N1 + x2 + y2 * 8) = 1 THEN Dist = PlusW * (XX * XX + YY * YY): EXIT FOR
                     END IF
                  NEXT YY
                  IF Dist THEN EXIT FOR
               NEXT XX
               IF Dist THEN EXIT FOR
            NEXT r
            IF Dist = 0 THEN Dist = 8 * PlusW
         ELSE
            FOR r = 1 TO 7
               FOR XX = -r TO r
                  FOR YY = -r TO r
                     x2 = x1 + XX
                     y2 = y1 + YY
                     IF (XX <> 0 OR YY <> 0) AND (x2 >= 0 AND x2 <= 7 AND y2 >= 0 AND y2 <= 7) THEN
                        IF Char(x2 + y2 * 8) = 1 THEN Dist = SubW * (XX * XX + YY * YY): EXIT FOR
                     END IF
                  NEXT YY
                  IF Dist THEN EXIT FOR
               NEXT XX
               IF Dist THEN EXIT FOR
            NEXT r
            IF Dist = 0 THEN Dist = 8 * SubW
         END IF
         n! = n! + Dist ^ (Index / 2) + NumWeight
      END IF
   NEXT B

   GetRatio! = n!

END FUNCTION

SUB GIF2TXT (A$)

SCREEN 13: CLS
GifLoad (A$)
Col2BW 0, 0, 319, 199
ConvertPic 0, 0, 631, 199

t = INSTR(A$, ".")
IF t THEN A$ = LEFT$(A$, t - 1)

OPEN A$ + ".TXT" FOR OUTPUT AS #1
PRINT #1, f$
CLOSE #1

END SUB

SUB GifLoad (A$)

DIM Prefix(4095), Suffix(4095), OutStack(4095), shiftout%(8)
DIM Ybase AS LONG, powersof2(11) AS LONG, WorkCode AS LONG

FOR A% = 0 TO 7: shiftout%(8 - A%) = 2 ^ A%: NEXT A%
FOR A% = 0 TO 11: powersof2(A%) = 2 ^ A%: NEXT A%
IF INSTR(A$, ".") = 0 THEN A$ = A$ + ".gif"
OPEN A$ FOR BINARY AS #9
A$ = "      ": GET #9, , A$
IF A$ <> "GIF87a" THEN PRINT "Not a GIF87a file.": END
GET #9, , TotalX: GET #9, , TotalY: GOSUB GetByte
NumColors = 2 ^ ((A% AND 7) + 1): NoPalette = (A% AND 128) = 0
GOSUB GetByte: Background = A%
GOSUB GetByte: IF A% <> 0 THEN PRINT "Bad screen descriptor.": END
IF NoPalette = 0 THEN P1$ = SPACE$(NumColors * 3): GET #9, , P1$
DO
    GOSUB GetByte
    IF A% = 44 THEN
        EXIT DO
    ELSEIF A% <> 33 THEN
        PRINT "Unknown extension type.": END
    END IF
    GOSUB GetByte
    DO: GOSUB GetByte: A$ = SPACE$(A%): GET #9, , A$: LOOP UNTIL A% = 0
LOOP
GET #9, , XStart: GET #9, , YStart: GET #9, , XLength: GET #9, , YLength
XEnd = XStart + XLength: YEnd = YStart + YLength: GOSUB GetByte
IF A% AND 128 THEN PRINT "Can't handle local colormaps.": END
Interlaced = A% AND 64: PassNumber = 0: PassStep = 8
GOSUB GetByte
ClearCode = 2 ^ A%
EOSCode = ClearCode + 1
FirstCode = ClearCode + 2: NextCode = FirstCode
StartCodeSize = A% + 1: CodeSize = StartCodeSize
StartMaxCode = 2 ^ (A% + 1) - 1: MaxCode = StartMaxCode

BitsIn = 0: BlockSize = 0: BlockPointer = 1
x% = XStart: y% = YStart: Ybase = y% * 320&

SCREEN 13: DEF SEG = &HA000
IF NoPalette = 0 THEN
    OUT &H3C7, 0: OUT &H3C8, 0
    FOR A% = 1 TO NumColors * 3
      z = ASC(MID$(P1$, A%, 1)) \ 4
      OUT &H3C9, z
      Pal((A% - 1) \ 3, (A% - 1) MOD 3) = z
    NEXT A%
END IF
LINE (0, 0)-(383, 199), Background, BF
DO
    GOSUB GetCode
    IF Code <> EOSCode THEN
        IF Code = ClearCode THEN
            NextCode = FirstCode
            CodeSize = StartCodeSize
            MaxCode = StartMaxCode
            GOSUB GetCode
            CurCode = Code: LastCode = Code: LastPixel = Code

            IF x% < 320 THEN
               IF LastPixel = 178 THEN LastPixel = 0
               POKE x% + Ybase, LastPixel
            END IF
            x% = x% + 1: IF x% = XEnd THEN GOSUB NextScanLine
        ELSE
            CurCode = Code: StackPointer = 0
            IF Code > NextCode THEN EXIT DO
            IF Code = NextCode THEN
                CurCode = LastCode
                OutStack(StackPointer) = LastPixel
                StackPointer = StackPointer + 1
            END IF

            DO WHILE CurCode >= FirstCode
                OutStack(StackPointer) = Suffix(CurCode)
                StackPointer = StackPointer + 1
                CurCode = Prefix(CurCode)
            LOOP

            LastPixel = CurCode
            IF x% < 320 THEN
               IF LastPixel = 178 THEN LastPixel = 0
               POKE x% + Ybase, LastPixel
            END IF
            x% = x% + 1: IF x% = XEnd THEN GOSUB NextScanLine

            FOR A% = StackPointer - 1 TO 0 STEP -1
                IF OutStack(A%) = 178 THEN OutStack(A%) = 0
                IF x% < 320 THEN POKE x% + Ybase, OutStack(A%)
                x% = x% + 1: IF x% = XEnd THEN GOSUB NextScanLine
            NEXT A%

            IF NextCode < 4096 THEN
                Prefix(NextCode) = LastCode
                Suffix(NextCode) = LastPixel
                NextCode = NextCode + 1
                IF NextCode > MaxCode AND CodeSize < 12 THEN
                    CodeSize = CodeSize + 1
                    MaxCode = MaxCode * 2 + 1
                END IF
            END IF
            LastCode = Code
        END IF
    END IF
LOOP UNTIL DoneFlag OR Code = EOSCode
CLOSE #9
EXIT SUB

GetByte: A$ = " ": GET #9, , A$: A% = ASC(A$): RETURN

NextScanLine:
    IF Interlaced THEN
        y% = y% + PassStep
        IF y% >= YEnd THEN
            PassNumber = PassNumber + 1
            SELECT CASE PassNumber
            CASE 1: y% = 4: PassStep = 8
            CASE 2: y% = 2: PassStep = 4
            CASE 3: y% = 1: PassStep = 2
            END SELECT
        END IF
    ELSE
        y% = y% + 1
    END IF
    x% = XStart: Ybase = y% * 320&: DoneFlag = y% > 199
RETURN
GetCode:
    IF BitsIn = 0 THEN GOSUB ReadBufferedByte: LastChar = A%: BitsIn = 8
    WorkCode = LastChar \ shiftout%(BitsIn)
    DO WHILE CodeSize > BitsIn
        GOSUB ReadBufferedByte: LastChar = A%
        WorkCode = WorkCode OR LastChar * powersof2(BitsIn)
        BitsIn = BitsIn + 8
    LOOP
    BitsIn = BitsIn - CodeSize
    Code = WorkCode AND MaxCode
RETURN
ReadBufferedByte:
    IF BlockPointer > BlockSize THEN
        GOSUB GetByte: BlockSize = A%
        A$ = SPACE$(BlockSize): GET #9, , A$
        BlockPointer = 1
    END IF
    A% = ASC(MID$(A$, BlockPointer, 1)): BlockPointer = BlockPointer + 1
RETURN


END SUB

SUB GrowFlower (n AS INTEGER)
' draw frame n in flower animation
'
' head, with 8 points
' 8 petals, each with 6 points (joined 1 from head)
' 2 leaves, each with 6 points (joined 1 from stem)
' stem, with 8 points
'
' frame 0: All points at (0, 0)
'
' frame 25:
' STEM: (0, 0) -> (0, 100)
' LEAVES: (0, 40) -> ((+/-)40, 40)
' HEAD: circular (r = 20) about (0, 100)
' PETALS: radial from HEAD (r = 40)
'
SCREEN 8: CLS : WINDOW SCREEN (-2, -20)-(398, 250): RANDOMIZE TIMER

PUT (0, 150), Ground(0), PSET

' draw stem:
FOR H = -10 TO Flower(n).Tallness
   FOR t = 1 TO 10
      PSET ((RND - .5) * Flower(n).Tallness / 15 + 100, 150 - H)
   NEXT t
NEXT H

' draw leaves
FOR s = -1 TO 1 STEP 2
   FOR H = 0 TO Flower(n).LeafSpread
      y1 = H * (Flower(n).LeafSpread - H) / 50
      FOR t! = 0 TO y1 STEP .7
         PSET (100 + s * H, 150 - Flower(n).Tallness * .25 + INT(RND * 2 * y1 + 1 - y1) - H * (1 - Flower(n).LeafSpread / 46.5))
      NEXT t!
   NEXT H
NEXT s

' draw head
FOR H = 1 TO Flower(n).HeadSize
   FOR r! = 0 TO 2 * PI STEP 2 * PI / H / 14
      PSET (100 + H * SIN(r!) + RND * 4 - 2, 150 - Flower(n).Tallness + H * COS(r!) + RND * 4 - 2)
   NEXT r!
NEXT H

' draw petals
FOR H = 1 TO Flower(n).PetalSpread
   FOR r! = 0 TO 2 * PI STEP 2 * PI / 9
      x1 = 100 + (H + Flower(n).HeadSize) * SIN(r!)
      y1 = 150 - Flower(n).Tallness + (H + Flower(n).HeadSize) * -COS(r!)
      dd = H * (Flower(n).PetalSpread - H) / 25
      FOR t = 1 TO dd * .9
         PSET (x1 + RND * dd - dd / 2, y1 + RND * dd - dd / 2)
      NEXT t
   NEXT r!
NEXT H

WINDOW

END SUB

SUB Init


IF Scaling < -1 THEN
   PlusW = -Scaling: SubW = 1
ELSEIF Scaling > 1 THEN
   PlusW = 1: SubW = Scaling
ELSE
   PlusW = 1: SubW = 1
END IF


SCREEN 8: CLS

FOR t = 32 TO 126
   LOCATE 1, 1: PRINT CHR$(t)
   FOR y = 0 TO 7: FOR x = 0 TO 7
      CharImg((t - 32) * 64 + y * 8 + x) = SGN(POINT(x, y))
   NEXT x: NEXT y
NEXT t

END SUB

SUB InitFlower

DIM F1 AS FlowerType, F2 AS FlowerType

SCREEN 8: CLS : WINDOW SCREEN (0, -20)-(400, 250): RANDOMIZE TIMER
FOR x = 0 TO 200
   LINE (x, 160)-(x + RND * 4 - 2, 160 - RND * 10)
NEXT x
GET (0, 150)-(200, 160), Ground(0)
CLS

FOR f = 1 TO 25
   Flower(f).Tallness = f * 4
   Flower(f).LeafSpread = 1.7 * f * (f / 25)
   Flower(f).PetalSpread = (f / 25) ^ 3 * f * 8 / 5
   Flower(f).HeadSize = (f / 25) * f * 8 / 15
NEXT f

FOR f = 26 TO 27
   Flower(f).Tallness = Flower(f - 1).Tallness - 1
   Flower(f).LeafSpread = Flower(f - 1).LeafSpread + 2
   Flower(f).PetalSpread = Flower(f - 1).PetalSpread + 2
   Flower(f).HeadSize = Flower(f - 1).HeadSize + 1
NEXT f

EXIT SUB

SCREEN 13
FOR f = 2 TO 27
   F1 = Flower(f - 1)
   F2 = Flower(f)
   LINE ((f - 1) * 10, 200 - F1.Tallness * 2)-(f * 10, 200 - F2.Tallness * 2), 15
   LINE ((f - 1) * 10, 200 - F1.LeafSpread * 2)-(f * 10, 200 - F2.LeafSpread * 2), 2
   LINE ((f - 1) * 10, 200 - F1.PetalSpread * 2)-(f * 10, 200 - F2.PetalSpread * 2), 4
NEXT f
WHILE INKEY$ = "": WEND
STOP



END SUB

SUB RippleHello (d AS INTEGER)

   DIM Temp(300) AS INTEGER

   CLS
   PUT (0, 50), hello(0), PSET

   FOR x1 = 0 TO 383
      ys = 15 * SIN((x1 + d) * PI / 180)
      GET (x1, 50)-(x1, 113), Temp(0)
      LINE (x1, 50)-(x1, 113), 0
      PUT (x1, 50 + ys), Temp(0), PSET
   NEXT x1

END SUB