Microsoft Programmer's Library 1.3/Microsoft-Programers-Library-v1.3.iso/sampcode/basic/edpat.bas

BASIC Source File | 1989-11-09 | 5.1 KB | 203 lines

DECLARE SUB DrawPattern ()
DECLARE SUB EditPattern ()
DECLARE SUB Initialize ()
DECLARE SUB ShowPattern (OK$)

DIM Bit%(0 TO 7), Pattern$, PatternSize%
DO
   Initialize
   EditPattern
   ShowPattern OK$
LOOP WHILE OK$ = "Y"

END
' ======================= DRAWPATTERN ====================
'  Draws a patterned rectangle on the right side of screen
' ========================================================

' ======================= EDITPATTERN =====================
'                  Edits a tile-byte pattern
' =========================================================


' ======================= INITIALIZE ======================
'             Sets up starting pattern and screen
' =========================================================

' ======================== SHOWPATTERN ====================
'   Prints the CHR$ values used by PAINT to make pattern
' =========================================================

SUB DrawPattern STATIC
SHARED Pattern$
   VIEW (320, 24)-(622, 160), 0, 1  ' Set view to rectangle.
   PAINT (1, 1), Pattern$       ' Use PAINT to fill it.
   VIEW                 ' Set view to full screen.

END SUB

SUB EditPattern STATIC
SHARED Pattern$, Bit%(), PatternSize%

   ByteNum% = 1     ' Starting position.
   BitNum% = 7
   Null$ = CHR$(0)  ' CHR$(0) is the first byte of the
                    ' two-byte string returned when a
                    ' direction key such as UP or DOWN is
                    ' pressed.
   DO

      ' Calculate starting location on screen of this bit:
      X% = ((7 - BitNum%) * 16) + 80
      Y% = (ByteNum% + 2) * 8

      ' Wait for a key press (flash cursor each 3/10 second):
      State% = 0
      RefTime = 0
      DO

     ' Check timer and switch cursor state if 3/10 second:
     IF ABS(TIMER - RefTime) > .3 THEN
        RefTime = TIMER
        State% = 1 - State%

        ' Turn the  border of bit on and off:
        LINE (X% - 1, Y% - 1)-STEP(15, 8), State%, B
     END IF

     Check$ = INKEY$    ' Check for keystroke.

      LOOP WHILE Check$ = ""    ' Loop until a key is pressed.

      ' Erase cursor:
      LINE (X% - 1, Y% - 1)-STEP(15, 8), 0, B

      SELECT CASE Check$    ' Respond to keystroke.

      CASE CHR$(27)     ' ESC key pressed:
         EXIT SUB       ' exit this subprogram.
      CASE CHR$(32)     ' SPACEBAR pressed:
                        ' reset state of bit.

         ' Invert bit in pattern string:
         CurrentByte% = ASC(MID$(Pattern$, ByteNum%, 1))
         CurrentByte% = CurrentByte% XOR Bit%(BitNum%)
         MID$(Pattern$, ByteNum%) = CHR$(CurrentByte%)

         ' Redraw bit on screen:
         IF (CurrentByte% AND Bit%(BitNum%)) <> 0 THEN
             CurrentColor% = 1
         ELSE
             CurrentColor% = 0
         END IF
         LINE (X% + 1, Y% + 1)-STEP(11, 4), CurrentColor%, BF

      CASE CHR$(13)      ' ENTER key pressed: draw
         DrawPattern         ' pattern in box on right.

      CASE Null$ + CHR$(75)  ' LEFT key: move cursor left.

         BitNum% = BitNum% + 1
         IF BitNum% > 7 THEN BitNum% = 0

      CASE Null$ + CHR$(77)  ' RIGHT key: move cursor right.

         BitNum% = BitNum% - 1
         IF BitNum% < 0 THEN BitNum% = 7

      CASE Null$ + CHR$(72)  ' UP key: move cursor up.

         ByteNum% = ByteNum% - 1
         IF ByteNum% < 1 THEN ByteNum% = PatternSize%

      CASE Null$ + CHR$(80)  ' DOWN key: move cursor down.

         ByteNum% = ByteNum% + 1
         IF ByteNum% > PatternSize% THEN ByteNum% = 1
      END SELECT
   LOOP
END SUB

SUB Initialize STATIC
SHARED Pattern$, Bit%(), PatternSize%

   ' Set up an array holding bits in positions 0 to 7:
   FOR I% = 0 TO 7
      Bit%(I%) = 2 ^ I%
   NEXT I%

   CLS

   ' Input the pattern size (in number of bytes):
   LOCATE 5, 5
   PRINT "Enter pattern size (1-16 rows):";
   DO
      LOCATE 5, 38
      PRINT "     ";
      LOCATE 5, 38
      INPUT "", PatternSize%
   LOOP WHILE PatternSize% < 1 OR PatternSize% > 16

   ' Set initial pattern to all bits set:
   Pattern$ = STRING$(PatternSize%, 255)

   SCREEN 2     ' 640 x 200 monochrome graphics mode

   ' Draw dividing lines:
   LINE (0, 10)-(635, 10), 1
   LINE (300, 0)-(300, 199)
   LINE (302, 0)-(302, 199)

   ' Print titles:
   LOCATE 1, 13: PRINT "Pattern Bytes"
   LOCATE 1, 53: PRINT "Pattern View"


' Draw editing screen for pattern:
   FOR I% = 1 TO PatternSize%

      ' Print label on left of each line:
      LOCATE I% + 3, 8
      PRINT USING "##:"; I%

      ' Draw "bit" boxes:
      X% = 80
      Y% = (I% + 2) * 8
      FOR J% = 1 TO 8
        LINE (X%, Y%)-STEP(13, 6), 1, BF
        X% = X% + 16
      NEXT J%
   NEXT I%

   DrawPattern      ' Draw  "Pattern View" box.

   LOCATE 21, 1
   PRINT "DIRECTION keys........Move cursor"
   PRINT "SPACEBAR............Changes point"
   PRINT "ENTER............Displays pattern"
   PRINT "ESC.........................Quits";

END SUB

SUB ShowPattern (OK$) STATIC
SHARED Pattern$, PatternSize%

   ' Return screen to 80-column text mode:
   SCREEN 0, 0
   WIDTH 80

   PRINT "The following characters make up your pattern:"
   PRINT

   ' Print out the value for each pattern byte:
   FOR I% = 1 TO PatternSize%
      PatternByte% = ASC(MID$(Pattern$, I%, 1))
      PRINT "CHR$("; LTRIM$(STR$(PatternByte%)); ")"
   NEXT I%
   PRINT
   LOCATE , , 1
   PRINT "New pattern? ";
   OK$ = UCASE$(INPUT$(1))
END SUB