home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / COMP8809.ZIP / SOURCE.EXE / INIT.INC < prev    next >
Encoding:
Text File  |  1988-04-21  |  8.5 KB  |  270 lines
  1. ' ******************** INITIALIZE ******************
  2.  
  3. Init:
  4.  
  5. %VideoSegment = &HB800
  6.  
  7. ' Get Current Drive and Current Path
  8. Path$=SPACE$(67)
  9.  
  10. CALL CurrentDrive(Drive)                         ' Get Current Drive
  11. CALL GetPath(0,Path$)                            ' and Path
  12.  
  13. Drive$=CHR$(Drive+65)+":\"
  14. Path$=Drive$+Path$
  15.  
  16. Spa=INSTR(Path$,CHR$(0))
  17. InitialPath$=LEFT$(Path$,(Spa-1))                ' For Help File
  18. Path$=InitialPath$
  19.  
  20.  
  21. DIM Border$(4),TITLE$(12)
  22. DIM WErrData(5),WBCharData(5),WFilesData(5),WPathData(5),WSaveData(5)
  23. DIM WMaskData(5),WBlockData(5),WFileNameData(5),WSCharData(5),WClearData(5)
  24.  
  25. ' Array to hold COLORS Window
  26. DIM WBack(208),WBackData(5),WFore(630),WForeData(5)
  27.  
  28. ' LARGE and SMALL array to hold Window
  29. DIM WLarge(2000),WLarge2(2000)
  30. DIM WSmall(240)
  31.  
  32. ' COLORS , ERROR & SAVE WINDOW DATA
  33. WBackData(0)=0  : WForeData(0)=0  : WErrData(0)=10 : WSaveData(0)=3  ' ROW
  34. WBackData(1)=10 : WForeData(1)=26 : WErrData(1)=26 : WSaveData(1)=16 ' COL
  35. WBackData(2)=16 : WForeData(2)=30 : WErrData(2)=28 : WSaveData(2)=22 ' WIDTH
  36. WBackData(3)=13 : WForeData(3)=21 : WErrData(3)=3  : WSaveData(3)=3  ' LENGTH
  37. WBackData(4)=11 : WForeData(4)=11 : WErrData(4)=79 : WSaveData(4)=11 ' ATTR
  38. WBackData(5)=2  : WForeData(5)=2  : WErrData(5)=2  : WSaveData(5)=1  ' TYPE
  39. ' FILES WINDOWS
  40. WFilesData(0)=1 : WPathData(0)=5 : WMaskData(0)=6 : WFileNameData(0)=2  ' ROW
  41. WFilesData(1)=1 : WPathData(1)=16: WMaskData(1)=16: WFileNameData(1)=16 ' COL
  42. WFilesData(2)=15: WPathData(2)=33: WMaskData(2)=16: WFileNameData(2)=16 ' WIDTH
  43. WFilesData(3)=9 : WPathData(3)=3 : WMaskData(3)=3 : WFileNameData(3)=3  ' LENGTH             
  44. WFilesData(4)=11: WPathData(4)=11: WMaskData(4)=11: WFileNameData(4)=11 ' ATTR
  45. WFilesData(5)=2 : WPathData(5)=1 : WMaskData(5)=1 : WFileNameData(5)=1  ' TYPE
  46. ' CHARACTER WINDOW
  47. WSCharData(0)=0 : WBCharData(0)=0 : WClearData(0)=10 ' ROW
  48. WSCharData(1)=0 : WBCharData(1)=0 : WClearData(1)=24 ' COL
  49. WSCharData(2)=40: WBCharData(2)=20: WClearData(2)=32 ' WIDTH
  50. WSCharData(3)=21: WBCharData(3)=14: WClearData(3)=3  ' LENGTH
  51. WSCharData(4)=11: WBCharData(4)=11: WClearData(4)=79 ' ATTR
  52. WSCharData(5)=2 : WBCharData(5)=2 : WClearData(5)=2  ' TYPE
  53.  
  54.  Arrow$=CHR$(24)+CHR$(25)+CHR$(27)+CHR$(26)      ' ARROW Characters
  55.  
  56.  LastChar$=" "
  57.  
  58.  Border$(0)="Move Cursor   "           ' Special Arrow keys
  59.  Border$(1)="Single Border "
  60.  Border$(2)="Double Border "
  61.  Border$(3)="Last Character"
  62.  Border$(4)="Change Color  "
  63.  
  64.  Arrow=0                               ' Turn off to start
  65.  OldArrow =1                           ' Single border
  66.  
  67.  Xpos=1                                ' Starting
  68.  Ypos=1                                ' X and Y positions
  69.  
  70.  FY=4
  71.  
  72.  XBox=2                                ' Starting
  73.  YBox=2                                ' Positions
  74.  XSpec=2                               ' for
  75.  YSpec=2                               ' HighLighting
  76.  XSave=18
  77.  YSave=5
  78.  
  79.  CurrentFore=15                        ' Set foreground
  80.  CurrentBack=0                         ' and Background colors
  81.  
  82.  Mask$="*.*"                           ' Initialize directory mask
  83.  FileName$="NONE"                      ' and file name
  84.  
  85.  TextHigh = 79                         ' Highlighting color
  86.  TextNorm = 14                         ' Normal color
  87.  
  88.  StatColor$="Black  Blue   Green  Cyan   Red    MagentaBrown  White  "
  89.  
  90.                                        ' Legal filename characters
  91. GoodFileName$="$&#%'()-@^{}!_0123456789"
  92. GoodFileName$=GoodFileName$+"ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  93. GoodFileName$=GoodFileName$+"abcdefghijklmnopqrstuvwxyz"
  94.  
  95. GoodMask$=GoodFileName$+"?*."
  96.  
  97. GoodPath$=GoodFileName$+":\."
  98.  
  99. ' Set-up Commands screen
  100. SCREEN 0,0,1,0
  101. COLOR 15,1
  102. CLS
  103. COLOR 15,4 : LOCATE 1,31 : PRINT" Command Summary "
  104. COLOR 15,1
  105. ? : ?
  106. PRINT " Function Keys F1-F10:  "STRING$( 15, 32)"Other key assignments:"
  107. COLOR  14, 1 : PRINT
  108. PRINT " F1 - HELP"STRING$( 29, 32)"Esc - Exit program or cancel command."
  109. PRINT " F2 - Files Menu"STRING$( 23, 32)"HOME - Move to start of current line."
  110. PRINT " F3 - Mark Block Begin"STRING$( 17, 32)"END - Move to end of current line."
  111. PRINT " F4 - Mark Block End"STRING$( 19, 32)"Ctrl HOME - Move to upper lefthand"
  112. PRINT " F5 - Colors Menu"STRING$( 34, 32)"corner of screen."STRING$( 12, 32);
  113. PRINT " F6 - Special Characters Menu          Ctrl END - Move to lower righthand"
  114. PRINT " F7 - Box Characters Menu"STRING$( 25, 32)"corner of screen."
  115. PRINT " F8 - Change Cursor Key Action         Ctrl right or left cursor - Move to"
  116. PRINT "      - Repeat Last Character"STRING$( 21, 32)"middle of current line."
  117. PRINT "      - Single Border Character        PgUp - Clear entire screen."
  118. PRINT "      - Double Border Character        PgDn - Toggle Special Cursor Mode."
  119. PRINT "      - Change Color"STRING$( 19, 32)"Cursor - Move cursor or perform"
  120. PRINT " F9 - Display Current Status"STRING$( 19, 32)"Special function."
  121. PRINT " F10- HELP       "STRING$( 22, 32)"(Check the status line at the bottom"
  122. PRINT STRING$( 39, 32)"of the screen for the current settings.)"
  123. LOCATE 24,1
  124. COLOR  15, 4 : PRINT " Press any key to continue ... ";
  125.  
  126. ' Print title screen
  127. SCREEN 0,0,0,0
  128. COLOR 14,0
  129. CLS
  130.  
  131.  
  132. TITLE$(1)="         ▒█████     ▒█████   ▒██████   ▒███████  ▒███████  ▒██   ▒██"
  133. TITLE$(2)="        ▒██  ▒██   ▒██  ▒██   ▒██ ▒██   ▒██  ▒█   ▒██  ▒█  ▒███  ▒██"
  134. TITLE$(3)="        ▒██       ▒██         ▒██ ▒██   ▒██       ▒██      ▒████ ▒██"
  135. TITLE$(4)="         ▒█████   ▒██         ▒████     ▒████     ▒████    ▒██▒██▒██"
  136. TITLE$(5)="             ▒██  ▒██         ▒██▒██    ▒██       ▒██      ▒██ ▒████"
  137. TITLE$(6)="        ▒██  ▒██   ▒██  ▒██   ▒██ ▒██   ▒██  ▒█   ▒██  ▒█  ▒██  ▒███"
  138. TITLE$(7)="         ▒█████     ▒█████   ▒███ ▒██  ▒███████  ▒███████  ▒██   ▒██"
  139. TITLE$(8)=SPACE$(79)
  140. TITLE$(9)=SPACE$(34)+"Ver  1.0"
  141. TITLE$(10)=SPACE$(79)
  142. TITLE$(11)=SPACE$(34)+"Ken Orlo"
  143. TITLE$(12)=SPACE$(79)
  144.  
  145. YStop=6
  146. FOR T=1 TO 12
  147. FOR Y=24 TO YStop STEP -1
  148. LOCATE Y,1
  149. ? TITLE$(T);
  150. NEXT Y
  151. YStop=YStop+1
  152. NEXT T
  153. ?
  154. LOCATE ,20
  155. ? "Copyright 1988 COMPUTE! Publications, Inc."
  156. LOCATE ,30
  157. ? "All rights reserved."
  158. LOCATE 23,1
  159. ? "Press any key to begin ...";
  160. CALL GetKey(A$)
  161. LOCATE 23,1
  162. ? "                          ";
  163.  
  164. YStop=6
  165. FOR T=1 TO 12
  166. FOR Y=YStop TO 1 STEP -1
  167. LOCATE Y,1
  168. ? TITLE$(T)
  169. NEXT Y
  170. YStop=YStop+1
  171. NEXT T
  172.  
  173. COLOR CurrentFore,CurrentBack
  174. CLS
  175. CALL Status
  176.  
  177. RETURN
  178.  
  179.  
  180. ' ******************* Window Routines ************************
  181. 'Opening Windows
  182. 'CALL OPENWINDOW(Window1(),Windowdata1())
  183. '
  184. 'Closing Windows
  185. 'CALL CLOSEWINDOW(Window1(),Windowdata1())
  186. '
  187. 'Window1=Array to hold window data.
  188. '        Dim window1 large enough. DIM Window1(WIDTH * LENGTH)
  189. '
  190. 'Windowdata1=Array to hold Window information
  191. '            Windowdata1(0)=ROW
  192. '            Windowdata1(1)=COL
  193. '            Windowdata1(2)=WIDTH
  194. '            Windowdata1(3)=LENGTH
  195. '            Windowdata1(4)=Border Attribute
  196. '            Windowdata1(5)=Type (1=Single 2=Double OTHER=No border)
  197. '
  198. ' **** THIS ROUTINE ASSUMES TO BE USED AT VIDEO PAGE 1 ****
  199.  
  200. SUB OPENWINDOW(ARRAY%(1),WDATA%(1))
  201.     LOCAL CORNER%,WID%,WLEN%,EXTRA%,ATTR%,BORDWID%,BORDLEN%
  202.  
  203.     CORNER%=WDATA%(0) * 160 + WDATA%(1) * 2
  204.     WID%=WDATA%(2)
  205.     WLEN%=WDATA%(3)
  206.     EXTRA%= (80 - WID%) * 2
  207.     ATTR%=WDATA%(4)
  208.     BORDWID%=WID%-2
  209.     BORDLEN%=WLEN%-2
  210.     TYPE%=WDATA%(5)
  211.  
  212.     ' WARNING! No error checking.
  213.  
  214.     CALL WINDOWON(ARRAY%(0),CORNER%,WID%,WLEN%,EXTRA%)
  215.     IF TYPE =1 THEN
  216.      CALL SINGLEBORDERON(CORNER%,BORDWID%,BORDLEN%,ATTR%,EXTRA%)
  217.      EXIT SUB
  218.     END IF
  219.     IF TYPE =2 THEN
  220.      CALL DOUBLEBORDERON(CORNER%,BORDWID%,BORDLEN%,ATTR%,EXTRA%)
  221.      EXIT SUB
  222.     END IF
  223.  
  224. END SUB
  225.  
  226.  
  227. SUB CLOSEWINDOW(ARRAY%(1),WDATA%(1))
  228.     LOCAL CORNER%,WID%,WLEN%,EXTRA%
  229.  
  230.     CORNER%=WDATA%(0) * 160 + WDATA%(1) * 2
  231.     WID%=WDATA%(2)
  232.     WLEN%=WDATA%(3)
  233.     EXTRA%= (80 - WID%) * 2
  234.  
  235.     CALL WINDOWOFF(ARRAY%(0),CORNER%,WID%,WLEN%,EXTRA%)
  236.  
  237. END SUB
  238.  
  239. ' ******************* INLINE Assembly Routines ************************
  240. ' WINDOWON - Save text under Window
  241. SUB WINDOWON INLINE
  242.     $INLINE "WINSAVE.BIN"
  243. END SUB
  244.  
  245. ' WINDOWOFF - Replace text under Window
  246. SUB WINDOWOFF INLINE
  247.     $INLINE "WINREST.BIN"
  248. END SUB
  249.  
  250. ' SINGLEBORDERON - Single Line border around Window
  251. SUB SINGLEBORDERON INLINE
  252.     $INLINE "SINBORD.BIN"
  253. END SUB
  254.  
  255. ' DOUBLEBORDERIN - Double Line border around Window
  256. SUB DOUBLEBORDERON INLINE
  257.     $INLINE "DOUBORD.BIN"
  258. END SUB
  259.  
  260.  
  261. ' GetPath - Gets the current Path
  262. SUB GetPath INLINE
  263.     $INLINE "DIRECT.BIN"
  264. END SUB
  265.  
  266. ' CurrentDrive - Returns 0=A , 1=B , etc.
  267. SUB CurrentDrive INLINE
  268.     $INLINE "DRIVE.BIN"
  269. END SUB
  270.