home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TBW_40.ZIP / TBWINDO.INC < prev   
Encoding:
Text File  |  1987-12-28  |  10.6 KB  |  285 lines
  1. DEFINT A-Z  ' THIS AFFECTS ENTIRE PROGRAM
  2.  
  3. MW = 30
  4. SCRNARRAY = 8000
  5.  
  6. DIM WROW(MW),WROWS(MW),WCOL(MW),WCOLS(MW),WATTR(MW)
  7. DIM WSHDW(MW),WLSTX(MW),WLSTY(MW),SCRN(SCRNARRAY),WPTR(MW)
  8.  
  9. SUB MAKEWINDOW(ROW,COL,ROWS,COLS,ATTR,BATTR,BRDRSEL,SHADOW,ZOOM) STATIC
  10.   SHARED WROW(),WROWS(),WCOL(),WCOLS(),WATTR(),WBATTR(),WBRDR(),WSHDW()
  11.   SHARED WLSTX(),WLSTY(),SCRN(),WPTR(),IDX
  12.   LOCAL R1,R2,C1,C2,COLRATIO,WSIZE
  13.   SELECT CASE SHADOW
  14.     REM LEFT
  15.     CASE = 1,3
  16.       C1=COL-2:C2=COLS+2:R2=ROWS+1
  17.     REM RIGHT
  18.     CASE = 2,4
  19.       C1=COL:C2=COLS+2:R2=ROWS+1
  20.     CASE ELSE
  21.       C1=COL:C2=COLS:R2=ROWS
  22.   END SELECT
  23.   WSIZE=(R2*C2)*2
  24.   WLSTX(IDX)=CSRLIN:WLSTY(IDX)=POS
  25.   IDX=IDX+1
  26.   WPTR(IDX+1)=WPTR(IDX)+WSIZE+1:WROW(IDX)=ROW:WCOL(IDX)=COL
  27.   WROWS(IDX)=ROWS:WCOLS(IDX)=COLS:WATTR(IDX)=ATTR:WSHDW(IDX)=SHADOW
  28.   CALL TBWSAVE(ROW,C1,R2,C2,SCRN(WPTR(IDX)))
  29.   IF ZOOM=1 THEN
  30.     R1=ROW+(ROWS\2):R2=ROW+ROWS-(ROWS\2):C1=COL+(COLS\2)
  31.     C2=COL+COLS-(COLS\2):COLRATIO=(COLS\ROWS)+1
  32.     IF COLRATIO>4 THEN COLRATIO=4
  33.     DO
  34.       IF R1>ROW THEN R1=R1-1
  35.       IF R2<(ROW+ROWS) THEN R2=R2+1
  36.       IF C1>COL THEN C1=C1-COLRATIO
  37.       IF C1<COL THEN C1=COL
  38.       IF C2<(COL+COLS) THEN C2=C2+COLRATIO
  39.       IF C2>(COL+COLS) THEN C2=COL+COLS
  40.       CALL TBWBOX(R1,C1,R2-R1,C2-C1,ATTR,BATTR,BRDRSEL)
  41.     LOOP UNTIL C1=COL AND C2=COL+COLS AND R1=ROW AND R2=ROW+ROWS
  42.   ELSE
  43.     CALL TBWBOX(ROW,COL,ROWS,COLS,ATTR,BATTR,BRDRSEL)
  44.   END IF
  45.   SELECT CASE SHADOW
  46.     REM LEFT
  47.     CASE = 1
  48.       CALL TBWFILL(ROW+1,COL-2,ROWS-1,2,ASC(" "),0)
  49.       CALL TBWFILL(ROW+ROWS,COL-2,1,COLS,ASC(" "),0)
  50.     REM RIGHT
  51.     CASE = 2
  52.       CALL TBWFILL(ROW+1,COL+COLS,ROWS-1,2,ASC(" "),0)
  53.       CALL TBWFILL(ROW+ROWS,COL+2,1,COLS,ASC(" "),0)
  54.     CASE = 3
  55.       CALL TBWATTR(ROW+1,COL-2,ROWS-1,2,FNATTR(8,0))
  56.       CALL TBWATTR(ROW+ROWS,COL-2,1,COLS,FNATTR(8,0))
  57.     REM RIGHT
  58.     CASE = 4
  59.       CALL TBWATTR(ROW+1,COL+COLS,ROWS-1,2,FNATTR(8,0))
  60.       CALL TBWATTR(ROW+ROWS,COL+2,1,COLS,FNATTR(8,0))
  61.   END SELECT
  62. END SUB
  63.  
  64. SUB TITLEWINDOW(DIR,ATTR,TITLE$) STATIC
  65. SHARED WROW(),WCOL(),WROWS(),WCOLS(),IDX
  66.   SELECT CASE DIR
  67.     REM UPPERLEFT
  68.     CASE = 1
  69.       CALL TBWPRINT(WROW(IDX),WCOL(IDX)+2,TITLE$,ATTR)
  70.     REM UPPERCENTER
  71.     CASE = 2
  72.       CALL TBWPRINTC(WROW(IDX),WCOL(IDX),WCOL(IDX)+WCOLS(IDX)-1,TITLE$,ATTR)
  73.     REM UPPERRIGHT
  74.     CASE = 3
  75.       CALL TBWPRINT(WROW(IDX),WCOL(IDX)+WCOLS(IDX)-LEN(TITLE$)-2,TITLE$,ATTR)
  76.     REM LOWERLEFT
  77.     CASE = 4
  78.       CALL TBWPRINT(WROW(IDX)+WROWS(IDX)-1,WCOL(IDX)+2,TITLE$,ATTR)
  79.     REM LOWERCENTER
  80.     CASE = 5
  81.       CALL TBWPRINTC(WROW(IDX)+WROWS(IDX)-1,WCOL(IDX),WCOL(IDX)+WCOLS(IDX)-1,TITLE$,ATTR)
  82.     REM LOWERRIGHT
  83.     CASE = 6
  84.       CALL TBWPRINT(WROW(IDX)+WROWS(IDX)-1,WCOL(IDX)+WCOLS(IDX)-LEN(TITLE$)-2,TITLE$,ATTR)
  85.   END SELECT
  86. END SUB
  87.  
  88. SUB REMOVEWINDOW STATIC
  89. SHARED WROW(),WCOL(),WROWS(),WCOLS(),WSHDW(),WLSTX(),WLSTY(),SCRN(),WPTR(),IDX
  90.   IF IDX=0 THEN
  91.     PRINT "IDX = 0"
  92.   ELSE
  93.     SELECT CASE WSHDW(IDX)
  94.       CASE = 1,3
  95.         CALL TBWREST(WROW(IDX),WCOL(IDX)-2,WROWS(IDX)+1,WCOLS(IDX)+2,SCRN(WPTR(IDX)))
  96.       CASE = 2,4
  97.         CALL TBWREST(WROW(IDX),WCOL(IDX),WROWS(IDX)+1,WCOLS(IDX)+2,SCRN(WPTR(IDX)))
  98.       CASE ELSE
  99.         CALL TBWREST(WROW(IDX),WCOL(IDX),WROWS(IDX),WCOLS(IDX),SCRN(WPTR(IDX)))
  100.     END SELECT
  101.     IDX = IDX -1
  102.     LOCATE WLSTX(IDX),WLSTY(IDX)
  103.   END IF
  104. END SUB
  105.  
  106. SUB TBWBOX(ROW,COL,ROWS,COLS,ATTR,BATTR,BRDRSEL) STATIC
  107.   IF ROWS>2 AND COLS>2 THEN
  108.     IF BRDRSEL>0 AND BRDRSEL<6 THEN
  109.       ON BRDRSEL GOSUB SINGLE,DOUBLE,MIXED12,MIXED21,DOUBLELEFTARROW
  110.       CALL TBWPRINT(ROW,COL,TL$,BATTR)
  111.       CALL TBWFILL (ROW,COL+1,1,COLS-2,ASC(HL$),BATTR)
  112.       CALL TBWPRINT(ROW,COL+COLS-1,TR$,BATTR)
  113.       CALL TBWFILL (ROW+1,COL,ROWS-2,1,ASC(VL$),BATTR)
  114.       CALL TBWFILL (ROW+1,COL+COLS-1,ROWS-2,1,ASC(VL$),BATTR)
  115.       CALL TBWPRINT(ROW+ROWS-1,COL,BL$,BATTR)
  116.       CALL TBWFILL (ROW+ROWS-1,COL+1,1,COLS-2,ASC(HL$),BATTR)
  117.       CALL TBWPRINT(ROW+ROWS-1,COL+COLS-1,BR$,BATTR)
  118.       CALL TBWFILL (ROW+1,COL+1,ROWS-2,COLS-2,ASC(" "),ATTR)
  119.     ELSE
  120.       CALL TBWFILL (ROW,COL,ROWS,COLS,ASC(" "),ATTR)
  121.     END IF
  122.   END IF
  123.   EXIT SUB
  124.  
  125.   SINGLE:
  126.     TL$=CHR$(218):TR$=CHR$(191)
  127.     BL$=CHR$(192):BR$=CHR$(217)
  128.     HL$=CHR$(196):VL$=CHR$(179)
  129.     RETURN
  130.   DOUBLE:
  131.     TL$=CHR$(201):TR$=CHR$(187)
  132.     BL$=CHR$(200):BR$=CHR$(188)
  133.     HL$=CHR$(205):VL$=CHR$(186)
  134.     RETURN
  135.   MIXED12:
  136.     TL$=CHR$(214):TR$=CHR$(183)
  137.     BL$=CHR$(211):BR$=CHR$(189)
  138.     HL$=CHR$(196):VL$=CHR$(186)
  139.     RETURN
  140.   MIXED21:
  141.     TL$=CHR$(213):TR$=CHR$(184)
  142.     BL$=CHR$(212):BR$=CHR$(190)
  143.     HL$=CHR$(205):VL$=CHR$(179)
  144.     RETURN
  145.   DOUBLELEFTARROW:
  146.     TL$=CHR$( 17):TR$=CHR$(187)
  147.     BL$=CHR$(200):BR$=CHR$(188)
  148.     HL$=CHR$(205):VL$=CHR$(186)
  149.     RETURN
  150. END SUB
  151.  
  152. SUB CLEARWINDOW STATIC
  153. SHARED WROW(),WCOL(),WROWS(),WCOLS(),WATTR(),IDX
  154.   CALL TBWFILL (WROW(IDX)+1,WCOL(IDX)+1,WROWS(IDX)-2,WCOLS(IDX)-2,ASC(" "),WATTR(IDX))
  155. END SUB
  156.  
  157. SUB PRTWINDOW(ROW,COL,STRDAT$) STATIC
  158. SHARED WROW(),WCOL(),WROWS(),WCOLS(),WATTR(),IDX
  159.    CALL TBWPRINT(WROW(IDX)+ROW,WCOL(IDX)+COL,STRDAT$,WATTR(IDX))
  160. END SUB
  161.  
  162. SUB PRTCWINDOW(ROW,STRDAT$) STATIC
  163. SHARED WROW(),WCOL(),WROWS(),WCOLS(),WATTR(),IDX
  164.    CALL TBWPRINTC(WROW(IDX)+ROW,WCOL(IDX),WCOL(IDX)+WCOLS(IDX),STRDAT$,WATTR(IDX))
  165. END SUB
  166.  
  167. SUB WINDOWXY(ROW,COL) STATIC
  168. SHARED WROW(),WCOL(),WROWS(),WCOLS(),WATTR(),IDX
  169.    LOCATE WROW(IDX)+ROW,WCOL(IDX)+COL
  170. END SUB
  171.  
  172. SUB TEXTBORDER(ATTR)
  173.   OUT &H03D9,ATTR
  174. END SUB
  175.  
  176. SUB MAKEMENU STATIC
  177.   SHARED WROW(),WROWS(),WCOL(),WCOLS(),WATTR(),WSHDW(),SCRN(),WPTR(),IDX
  178.   SHARED ITEM$(),ITEMCOUNT,STARTPOS,CURNTPOS
  179.   LOCAL DONE
  180.   DONE = 0
  181.   FOR MLOOP = 1 TO ITEMCOUNT
  182.     CALL TBWPRINTC(WROW(IDX)+MLOOP,WCOL(IDX),WCOL(IDX)+WCOLS(IDX),ITEM$(MLOOP),WATTR(IDX))
  183.   NEXT
  184.   IF CURNTPOS = 0 THEN IF STARTPOS = 0 THEN CURNTPOS = 1 ELSE CURNTPOS = STARTPOS
  185.   DO
  186.     CALL TBWATTR(WROW(IDX)+CURNTPOS,WCOL(IDX)+1,1,WCOLS(IDX)-2,FNATTR%(0,7))
  187.     WHILE NOT INSTAT
  188.     WEND
  189.     ANS$=INKEY$
  190.     IF LEN(ANS$)=2 THEN ANS$=RIGHT$(ANS$,1)
  191.     CALL TBWATTR(WROW(IDX)+CURNTPOS,WCOL(IDX)+1,1,WCOLS(IDX)-2,WATTR(IDX))
  192.     SELECT CASE ANS$
  193.       CASE CHR$(72),CHR$(75),"-","8","4"
  194.         DECR CURNTPOS
  195.       CASE CHR$(80),CHR$(77),"+","2","6"
  196.         INCR CURNTPOS
  197.       CASE CHR$(13)
  198.         DONE = -1
  199.       CASE CHR$(27)
  200.         CURNTPOS=0
  201.         DONE = -1
  202.       CASE ELSE
  203.         CURNTPOS = CURNTPOS
  204.     END SELECT
  205.     IF CURNTPOS > ITEMCOUNT THEN CURNTPOS = 1
  206.     IF CURNTPOS < 1 THEN CURNTPOS = ITEMCOUNT
  207.   LOOP UNTIL DONE
  208. END SUB
  209.  
  210. DEF FNATTR(FORE,BACK)
  211.   LOCAL TEMP
  212.   TEMP=(BACK*16)+FORE
  213.   IF FORE>15 THEN TEMP = TEMP + 112
  214.   FNATTR = TEMP
  215. END DEF
  216.  
  217. SUB TBWPRINT  INLINE
  218.   $INLINE &H55,&H8B,&HEC,&H1E,&H06,&HC4,&H7E,&H0A,&H26,&H8B,&H0D,&H81,&HE1,&HFF
  219.   $INLINE &H7F,&HE3,&H5B,&H51,&H8B,&H16,&H00,&H00,&H52,&HB4,&H0F,&HCD,&H10,&H3C
  220.   $INLINE &H07,&H75,&H08,&HBB,&H00,&HB0,&HBA,&HBA,&H03,&HEB,&H06,&HBB,&H00,&HB8
  221.   $INLINE &HBA,&HDA,&H03,&H53,&H07,&H52,&H33,&HDB,&H8A,&HDC,&HC5,&H76,&H12,&H8B
  222.   $INLINE &H04,&H48,&HF7,&HE3,&HD1,&HE0,&HC5,&H76,&H0E,&H8B,&H1C,&H4B,&HD1,&HE3
  223.   $INLINE &H03,&HD8,&H8B,&HFB,&HC5,&H76,&H06,&H8B,&H1C,&HC5,&H76,&H0A,&H8B,&H74
  224.   $INLINE &H02,&H5A,&H1F,&H59,&HFC,&HFA,&HEC,&HA8,&H01,&H75,&HFB,&HEC,&HA8,&H01
  225.   $INLINE &H74,&HFB,&HA4,&H26,&H88,&H1D,&H47,&HE2,&HEF,&HFB,&H07,&H1F,&H5D
  226. END SUB
  227.  
  228. SUB TBWPRINTC  INLINE
  229.   $INLINE &H55,&H8B,&HEC,&H1E,&H06,&HC4,&H7E,&H0A,&H26,&H8B,&H0D,&H81,&HE1,&HFF
  230.   $INLINE &H7F,&HE3,&H6A,&H51,&H8B,&H16,&H00,&H00,&H52,&HB4,&H0F,&HCD,&H10,&H3C
  231.   $INLINE &H07,&H75,&H08,&HBB,&H00,&HB0,&HBA,&HBA,&H03,&HEB,&H06,&HBB,&H00,&HB8
  232.   $INLINE &HBA,&HDA,&H03,&H53,&H07,&H52,&H33,&HDB,&H8A,&HDC,&HC5,&H76,&H16,&H8B
  233.   $INLINE &H04,&H48,&HF7,&HE3,&HD1,&HE0,&HC5,&H76,&H12,&H8A,&H1C,&HC5,&H76,&H0E
  234.   $INLINE &H8A,&H3C,&H02,&HDF,&H32,&HFF,&HD1,&HEB,&HD1,&HE9,&H2B,&HD9,&H4B,&HD1
  235.   $INLINE &HE3,&H03,&HD8,&H8B,&HFB,&HC5,&H76,&H06,&H8B,&H1C,&HC5,&H76,&H0A,&H8B
  236.   $INLINE &H74,&H02,&H5A,&H1F,&H59,&HFC,&HFA,&HEC,&HA8,&H01,&H75,&HFB,&HEC,&HA8
  237.   $INLINE &H01,&H74,&HFB,&HA4,&H26,&H88,&H1D,&H47,&HE2,&HEF,&HFB,&H07,&H1F,&H5D
  238. END SUB
  239.  
  240. SUB TBWFILL  INLINE
  241.   $INLINE &H55,&H8B,&HEC,&H1E,&H06,&HB4,&H0F,&HCD,&H10,&H3C,&H07,&H75,&H08,&HBB
  242.   $INLINE &H00,&HB0,&HBA,&HBA,&H03,&HEB,&H06,&HBB,&H00,&HB8,&HBA,&HDA,&H03,&H53
  243.   $INLINE &H07,&HC5,&H76,&H12,&H8B,&H0C,&H51,&H52,&H33,&HDB,&H8A,&HDC,&HC5,&H76
  244.   $INLINE &H1A,&H8B,&H04,&H48,&HF7,&HE3,&HD1,&HE0,&HC5,&H76,&H16,&H8B,&H1C,&H4B
  245.   $INLINE &HD1,&HE3,&H03,&HD8,&H8B,&HFB,&HC5,&H76,&H0A,&H8B,&H04,&H8A,&HD8,&HC5
  246.   $INLINE &H76,&H06,&H8B,&H04,&H8A,&HE0,&HFC,&HC5,&H76,&H0E,&H8B,&H34,&H5A,&H57
  247.   $INLINE &H8B,&HCE,&HFA,&HEC,&HA8,&H01,&H75,&HFB,&HEC,&HA8,&H01,&H74,&HFB,&H8A
  248.   $INLINE &HC3,&HAB,&HE2,&HF1,&HFB,&H5F,&H59,&H49,&HE3,&H07,&H51,&H81,&HC7,&HA0
  249.   $INLINE &H00,&HEB,&HE0,&H07,&H1F,&H5D
  250. END SUB
  251.  
  252. SUB TBWATTR INLINE
  253.   $INLINE &H55,&H8B,&HEC,&H1E,&H06,&HB4,&H0F,&HCD,&H10,&H3C,&H07,&H75,&H08,&HBB
  254.   $INLINE &H00,&HB0,&HBA,&HBA,&H03,&HEB,&H06,&HBB,&H00,&HB8,&HBA,&HDA,&H03,&H53
  255.   $INLINE &H07,&HC5,&H76,&H0E,&H8B,&H0C,&H51,&H52,&H33,&HDB,&H8A,&HDC,&HC5,&H76
  256.   $INLINE &H16,&H8B,&H04,&H48,&HF7,&HE3,&HD1,&HE0,&HC5,&H76,&H12,&H8B,&H1C,&H4B
  257.   $INLINE &HD1,&HE3,&H03,&HD8,&H8B,&HFB,&HC5,&H76,&H06,&H8B,&H1C,&HFC,&HC5,&H76
  258.   $INLINE &H0A,&H8B,&H34,&H5A,&H57,&HFA,&H8B,&HCE,&H47,&HEC,&HA8,&H01,&H75,&HFB
  259.   $INLINE &HEC,&HA8,&H01,&H74,&HFB,&H8A,&HC3,&HAA,&HE2,&HF0,&HFB,&H5F,&H59,&H49
  260.   $INLINE &HE3,&H07,&H51,&H81,&HC7,&HA0,&H00,&HEB,&HDF,&H07,&H1F,&H5D
  261. END SUB
  262.  
  263. SUB TBWSAVE  INLINE
  264.   $INLINE &H55,&H8B,&HEC,&H1E,&H06,&HB4,&H0F,&HCD,&H10,&H3C,&H07,&H75,&H08,&HBB
  265.   $INLINE &H00,&HB0,&HBA,&HBA,&H03,&HEB,&H06,&HBB,&H00,&HB8,&HBA,&HDA,&H03,&H53
  266.   $INLINE &H1F,&HC4,&H7E,&H0E,&H26,&H8B,&H0D,&H51,&H52,&H33,&HDB,&H8A,&HDC,&HC4
  267.   $INLINE &H7E,&H16,&H26,&H8B,&H05,&H48,&HF7,&HE3,&HD1,&HE0,&HC4,&H7E,&H12,&H26
  268.   $INLINE &H8B,&H1D,&H4B,&HD1,&HE3,&H03,&HD8,&H8B,&HF3,&HC4,&H7E,&H0A,&H26,&H8B
  269.   $INLINE &H1D,&HC4,&H7E,&H06,&HFC,&H5A,&H56,&HFA,&H8B,&HCB,&HEC,&HA8,&H01,&H75
  270.   $INLINE &HFB,&HEC,&HA8,&H01,&H74,&HFB,&HA5,&HE2,&HF3,&HFB,&H5E,&H59,&H49,&HE3
  271.   $INLINE &H07,&H51,&H81,&HC6,&HA0,&H00,&HEB,&HE2,&H07,&H1F,&H5D
  272. END SUB
  273.  
  274. SUB TBWREST  INLINE
  275.   $INLINE &H55,&H8B,&HEC,&H1E,&H06,&HB4,&H0F,&HCD,&H10,&H3C,&H07,&H75,&H08,&HBB
  276.   $INLINE &H00,&HB0,&HBA,&HBA,&H03,&HEB,&H06,&HBB,&H00,&HB8,&HBA,&HDA,&H03,&H53
  277.   $INLINE &H07,&HC5,&H76,&H0E,&H8B,&H0C,&H51,&H52,&H33,&HDB,&H8A,&HDC,&HC5,&H76
  278.   $INLINE &H16,&H8B,&H04,&H48,&HF7,&HE3,&HD1,&HE0,&HC5,&H76,&H12,&H8B,&H1C,&H4B
  279.   $INLINE &HD1,&HE3,&H03,&HD8,&H8B,&HFB,&HC5,&H76,&H0A,&H8B,&H1C,&HC5,&H76,&H06
  280.   $INLINE &HFC,&H5A,&H57,&HFA,&H8B,&HCB,&HEC,&HA8,&H01,&H75,&HFB,&HEC,&HA8,&H01
  281.   $INLINE &H74,&HFB,&HA5,&HE2,&HF3,&HFB,&H5F,&H59,&H49,&HE3,&H07,&H51,&H81,&HC7
  282.   $INLINE &HA0,&H00,&HEB,&HE2,&H07,&H1F,&H5D
  283. END SUB
  284.  
  285.