home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l196 / 3.ddi / EDPAT.BA$ / EDPAT.bin
Encoding:
Text File  |  1990-06-24  |  5.1 KB  |  199 lines
  1. DECLARE SUB DrawPattern ()
  2. DECLARE SUB EditPattern ()
  3. DECLARE SUB Initialize ()
  4. DECLARE SUB ShowPattern (OK$)
  5.  
  6. DIM Bit%(0 TO 7), Pattern$, PatternSize%
  7. DO
  8.    Initialize
  9.    EditPattern
  10.    ShowPattern OK$
  11. LOOP WHILE OK$ = "Y"
  12.  
  13. END
  14.  
  15. ' ======================= DRAWPATTERN ====================
  16. '  Draws a patterned rectangle on the right side of screen
  17. ' ========================================================
  18. SUB DrawPattern STATIC
  19. SHARED Pattern$
  20.    VIEW (320, 24)-(622, 160), 0, 1  ' Set view to rectangle.
  21.    PAINT (1, 1), Pattern$       ' Use PAINT to fill it.
  22.    VIEW                 ' Set view to full screen.
  23.  
  24. END SUB
  25.  
  26. ' ======================= EDITPATTERN =====================
  27. '                  Edits a tile-byte pattern
  28. ' =========================================================
  29. SUB EditPattern STATIC
  30. SHARED Pattern$, Bit%(), PatternSize%
  31.  
  32.    ByteNum% = 1     ' Starting position.
  33.    BitNum% = 7
  34.    Null$ = CHR$(0)  ' CHR$(0) is the first byte of the
  35.                     ' two-byte string returned when a
  36.                     ' direction key such as UP or DOWN is
  37.                     ' pressed.
  38.    DO
  39.  
  40.       ' Calculate starting location on screen of this bit:
  41.       X% = ((7 - BitNum%) * 16) + 80
  42.       Y% = (ByteNum% + 2) * 8
  43.  
  44.       ' Wait for a key press (flash cursor each 3/10 second):
  45.       State% = 0
  46.       RefTime = 0
  47.       DO
  48.  
  49.      ' Check timer and switch cursor state if 3/10 second:
  50.      IF ABS(TIMER - RefTime) > .3 THEN
  51.         RefTime = TIMER
  52.         State% = 1 - State%
  53.  
  54.         ' Turn the  border of bit on and off:
  55.         LINE (X% - 1, Y% - 1)-STEP(15, 8), State%, B
  56.      END IF
  57.  
  58.      Check$ = INKEY$    ' Check for keystroke.
  59.  
  60.       LOOP WHILE Check$ = ""    ' Loop until a key is pressed.
  61.  
  62.       ' Erase cursor:
  63.       LINE (X% - 1, Y% - 1)-STEP(15, 8), 0, B
  64.  
  65.       SELECT CASE Check$    ' Respond to keystroke.
  66.  
  67.       CASE CHR$(27)     ' ESC key pressed:
  68.          EXIT SUB       ' exit this subprogram.
  69.       CASE CHR$(32)     ' SPACEBAR pressed:
  70.                         ' reset state of bit.
  71.  
  72.          ' Invert bit in pattern string:
  73.          CurrentByte% = ASC(MID$(Pattern$, ByteNum%, 1))
  74.          CurrentByte% = CurrentByte% XOR Bit%(BitNum%)
  75.          MID$(Pattern$, ByteNum%) = CHR$(CurrentByte%)
  76.  
  77.          ' Redraw bit on screen:
  78.          IF (CurrentByte% AND Bit%(BitNum%)) <> 0 THEN
  79.              CurrentColor% = 1
  80.          ELSE
  81.              CurrentColor% = 0
  82.          END IF
  83.          LINE (X% + 1, Y% + 1)-STEP(11, 4), CurrentColor%, BF
  84.  
  85.       CASE CHR$(13)      ' ENTER key pressed: draw
  86.          DrawPattern         ' pattern in box on right.
  87.  
  88.       CASE Null$ + CHR$(75)  ' LEFT key: move cursor left.
  89.  
  90.          BitNum% = BitNum% + 1
  91.          IF BitNum% > 7 THEN BitNum% = 0
  92.  
  93.       CASE Null$ + CHR$(77)  ' RIGHT key: move cursor right.
  94.  
  95.          BitNum% = BitNum% - 1
  96.          IF BitNum% < 0 THEN BitNum% = 7
  97.  
  98.       CASE Null$ + CHR$(72)  ' UP key: move cursor up.
  99.  
  100.          ByteNum% = ByteNum% - 1
  101.          IF ByteNum% < 1 THEN ByteNum% = PatternSize%
  102.  
  103.       CASE Null$ + CHR$(80)  ' DOWN key: move cursor down.
  104.  
  105.          ByteNum% = ByteNum% + 1
  106.          IF ByteNum% > PatternSize% THEN ByteNum% = 1
  107.       END SELECT
  108.    LOOP
  109. END SUB
  110.  
  111. ' ======================= INITIALIZE ======================
  112. '             Sets up starting pattern and screen
  113. ' =========================================================
  114. SUB Initialize STATIC
  115. SHARED Pattern$, Bit%(), PatternSize%
  116.  
  117.    ' Set up an array holding bits in positions 0 to 7:
  118.    FOR I% = 0 TO 7
  119.       Bit%(I%) = 2 ^ I%
  120.    NEXT I%
  121.  
  122.    CLS
  123.  
  124.    ' Input the pattern size (in number of bytes):
  125.    LOCATE 5, 5
  126.    PRINT "Enter pattern size (1-16 rows):";
  127.    DO
  128.       LOCATE 5, 38
  129.       PRINT "     ";
  130.       LOCATE 5, 38
  131.       INPUT "", PatternSize%
  132.    LOOP WHILE PatternSize% < 1 OR PatternSize% > 16
  133.  
  134.    ' Set initial pattern to all bits set:
  135.    Pattern$ = STRING$(PatternSize%, 255)
  136.  
  137.    SCREEN 2     ' 640 x 200 monochrome graphics mode
  138.  
  139.    ' Draw dividing lines:
  140.    LINE (0, 10)-(635, 10), 1
  141.    LINE (300, 0)-(300, 199)
  142.    LINE (302, 0)-(302, 199)
  143.  
  144.    ' Print titles:
  145.    LOCATE 1, 13: PRINT "Pattern Bytes"
  146.    LOCATE 1, 53: PRINT "Pattern View"
  147.  
  148.  
  149. ' Draw editing screen for pattern:
  150.    FOR I% = 1 TO PatternSize%
  151.  
  152.       ' Print label on left of each line:
  153.       LOCATE I% + 3, 8
  154.       PRINT USING "##:"; I%
  155.  
  156.       ' Draw "bit" boxes:
  157.       X% = 80
  158.       Y% = (I% + 2) * 8
  159.       FOR J% = 1 TO 8
  160.         LINE (X%, Y%)-STEP(13, 6), 1, BF
  161.         X% = X% + 16
  162.       NEXT J%
  163.    NEXT I%
  164.  
  165.    DrawPattern      ' Draw  "Pattern View" box.
  166.  
  167.    LOCATE 21, 1
  168.    PRINT "DIRECTION keys........Move cursor"
  169.    PRINT "SPACEBAR............Changes point"
  170.    PRINT "ENTER............Displays pattern"
  171.    PRINT "ESC.........................Quits";
  172.  
  173. END SUB
  174.  
  175. ' ======================== SHOWPATTERN ====================
  176. '   Prints the CHR$ values used by PAINT to make pattern
  177. ' =========================================================
  178. SUB ShowPattern (OK$) STATIC
  179. SHARED Pattern$, PatternSize%
  180.  
  181.    ' Return screen to 80-column text mode:
  182.    SCREEN 0, 0
  183.    WIDTH 80
  184.  
  185.    PRINT "The following characters make up your pattern:"
  186.    PRINT
  187.  
  188.    ' Print out the value for each pattern byte:
  189.    FOR I% = 1 TO PatternSize%
  190.       PatternByte% = ASC(MID$(Pattern$, I%, 1))
  191.       PRINT "CHR$("; LTRIM$(STR$(PatternByte%)); ")"
  192.    NEXT I%
  193.    PRINT
  194.    LOCATE , , 1
  195.    PRINT "New pattern? ";
  196.    OK$ = UCASE$(INPUT$(1))
  197. END SUB
  198.  
  199.