home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World Komputer 1995 November
/
PCWK1195.iso
/
inne
/
dos
/
fraktale
/
fracxtr6.exe
/
OTHER
/
FIMAPS.ZIP
/
FIMAPS.CLA
< prev
next >
Wrap
Text File
|
1993-10-30
|
64KB
|
1,816 lines
!═══════════════════════════════════════════════════════════════════════════════
! FIMAPS 1.0 - Creates random smooth color maps for use by Fractint.
! This program is in the public domain.
! Written in Clarion Professional Developer 2.1
! by Nick Grasso, 4092 Murphy Road, Thompson, Ohio 44086, U.S.A.
! I can also be reached on the RIME Fractal Conference.
!═══════════════════════════════════════════════════════════════════════════════
FIMAPS PROGRAM
INCLUDE('STD_KEYS.CLA')
SHFT_TAB EQUATE(276)
PLUS_KEY EQUATE(43)
MINUS_KEY EQUATE(45)
LEFT_ANGLE EQUATE(60)
RIGHT_ANGLE EQUATE(62)
COMMA_KEY EQUATE(44)
PERIOD_KEY EQUATE(46)
CTRL_PGUP EQUATE(284)
CTRL_PGDN EQUATE(288)
MAP
!───────────────────────────────────────────────────────────────────────────
! INTERNAL SUBROUTINES.
!───────────────────────────────────────────────────────────────────────────
FUNC(CONFIRM),STRING !CONFIRM FILE OVERWRITE OR QUIT PROGRAM
FUNC(VERIFILE),LONG !VERIFY GIF FILE, DISPLAY FILE LIST
PROC(EXEC_EXT) !RUN A DOS COMMAND
!───────────────────────────────────────────────────────────────────────────
! EXTERNAL SUBROUTINES - AKATOOLS 2.5
!───────────────────────────────────────────────────────────────────────────
MODULE('AKAVideo'),BINARY
FUNC(VidIsVGA),LONG !is it a VGA video adapter?
END!MODULE
MODULE('AKAClars.BIN'),BINARY
PROC(ClaSetBlkMax) !set (or disable) Clarion's video timeout
END!MODULE
MODULE('AKAEnvir' ),BINARY
FUNC(EnvProgPath ),STRING !path of EXE (used to locate .CFG file)
END!MODULE
MODULE('AKAFiles' ),BINARY
FUNC(FilExists ),LONG !return whether passed file exists
FUNC(FilFullName ),STRING !return full name of passed file
FUNC(FilDrive ),STRING !return drive of passed file
FUNC(FilDirectory),STRING !return directory of passed file
FUNC(FilName ),STRING !return name of passed file
FUNC(FilExtension),STRING !return extension of passed file
END!MODULE
MODULE('AKADirec'),BINARY
FUNC(DirGetFirst ),STRING !begin reading directory
FUNC(DirGetNext ),STRING !continue reading directory
END!MODULE
!───────────────────────────────────────────────────────────────────────────
! EXTERNAL SUBROUTINES - PCX3
!───────────────────────────────────────────────────────────────────────────
MODULE('PCX3'),BINARY
PROC(SETVMODE) !SET VIDEO MODE
PROC(LINE) !DRAW A LINE
PROC(SETCOLOR) !SET VIDEO COLOR
FUNC(RED),LONG !READ VIDEO COLOR - RED
FUNC(GREEN),LONG !READ VIDEO COLOR - GREEN
FUNC(BLUE),LONG !READ VIDEO COLOR - BLUE
END!MODULE
END!MAP
!───────────────────────────────────────────────────────────────────────────────
! SCREEN FOR MAIN MENU.
!───────────────────────────────────────────────────────────────────────────────
SCREEN SCREEN PRE(SCR),HUE(7,0)
OMIT('**-END-**')
█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█
█ Memory: <<<,<<# FRACTINT MAP CREATION PROGRAM v1.0 █
█▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄█
█ █
█ No. of color ranges: <<# Repeat every: <<# █
█ Neon: ■ Neon color: R:<# G:<# B:<# █
█ Set color 0: ■ █
█ Save map filename: ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ █
█ Prompt if file exists: ■ █
█ View GIF filename: ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ █
█ █
█ ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ █
█──────────────────────────────────────────────────────────────────────────────█
█ While viewing a map: F5 views the GIF file █
█ While viewing a map or a GIF: Enter or F9 creates a new map █
█ < or > rotates color palette █
█ 1 thru 0 rotates palette times 10 █
█ + or - changes direction of rotation █
█ (you must return here to save the map) █
█──────────────────────────────────────────────────────────────────────────────█
█ ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ █
█▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄█
■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ F8-Execute DOS command
F1-Help F2-Configure F3-Exit
F4-View current map F5-View GIF F6-Save current map to file F9-Create new map
**-END-**
ROW(2,1) PAINT(20,1),HUE(9,0)
ROW(25,1) PAINT(1,79),HUE(9,0)
ROW(2,80) PAINT(24,1),HUE(9,0)
ROW(1,1) PAINT(1,80),HUE(9,0)
ROW(3,2) PAINT(1,79),HUE(9,0)
ROW(24,1) PAINT(1,80),HUE(9,0)
ROW(5,26) PAINT(6,1),HUE(15,0)
ROW(22,1) PAINT(1,79),HUE(9,0)
ROW(9,4) PAINT(1,51),HUE(7,0)
ROW(19,2) PAINT(2,78),HUE(9,0)
ROW(11,2) PAINT(1,79),HUE(9,0)
ROW(18,1) PAINT(1,79),HUE(9,0)
ROW(23,1) PAINT(1,80),HUE(3,0)
ROW(2,3) PAINT(1,77),HUE(5,0)
ROW(2,27) PAINT(1,29),HUE(13,0)
ROW(12,2) PAINT(6,78),HUE(9,0)
ROW(1,1) STRING('█▀{78}█')
ROW(2,1) REPEAT(2),EVERY(19);STRING('█<0{78}>█') .
ROW(3,1) REPEAT(2),EVERY(19);STRING('█▄{78}█') .
ROW(4,1) REPEAT(9);STRING('█<0{78}>█') .
ROW(13,1) REPEAT(2),EVERY(7);STRING('█─{78}█') .
ROW(14,1) REPEAT(6);STRING('█<0{78}>█') .
ROW(2,4) STRING('Memory:')
COL(27) STRING('FRACTINT MAP CREATION PROGRAM')
COL(74) STRING('v1.0')
ROW(14,14) STRING('While viewing a map: F5 views the GIF file')
ROW(15,5) STRING('While viewing a map or a GIF: Enter or F9 creates a new map')
ROW(16,35) STRING('<< or > rotates color palette')
ROW(17,35) STRING('1 thru 0 rotates palette times 10')
ROW(18,35) STRING('+ or - changes direction of rotation')
ROW(19,35) STRING('(you must return here to save the map)')
ROW(23,59) STRING('F8-Execute DOS command')
ROW(24,1) STRING('F1-Help {27}F2-Configure {27}F3-Exit')
ROW(25,1) STRING('F4-View current map F5-View GIF F6-Save current map to ' |
& 'file F9-Create new map')
MEM_LEFT ROW(2,12) STRING(@N7)
ROW(5,5) STRING('No. of color ranges:')
COL(26) ENTRY(@N3),USE(RANGE),INS,IMM,NUM
COL(33) STRING('Repeat every:')
COL(47) ENTRY(@N3),USE(REPEAT),ENH,INS,IMM,NUM
ROW(6,20) STRING('Neon:')
COL(26) ENTRY(@S1),USE(NEON),IMM,UPR
COL(35) STRING('Neon color: R:')
COL(49) ENTRY(@N2),USE(NEONR),ENH,INS,IMM,NUM
COL(52) STRING('G:')
COL(54) ENTRY(@N2),USE(NEONG),ENH,INS,IMM,NUM
COL(57) STRING('B:')
COL(59) ENTRY(@N2),USE(NEONB),ENH,INS,IMM,NUM
ROW(7,13) STRING('Set color 0:')
COL(26) ENTRY(@S1),USE(SET0),ENH,IMM,UPR
ROW(8,7) STRING('Save map filename:')
COL(26) ENTRY(@S50),USE(DOSNAME),ENH,LFT,UPR
ROW(9,36) STRING('Prompt if file exists:')
COL(59) ENTRY(@S1),USE(PROMPT),ENH,IMM,UPR
ROW(10,7) STRING('View GIF filename:')
COL(26) ENTRY(@S50),USE(GIFNAME),ENH,LFT,UPR
MESSAGE ROW(21,16) STRING(50),HUE(14,0)
ROW(22,79) ENTRY,USE(?ACCEPT)
ROW(12,4) ENTRY(@S74),USE(F5_TEXT),HUE(3,0)
ROW(23,1) ENTRY(@S57),USE(F7_TEXT)
.
!───────────────────────────────────────────────────────────────────────────────
! CONFIGURATION SETUP WINDOW.
!───────────────────────────────────────────────────────────────────────────────
CFG_SCR SCREEN WINDOW(19,61),AT(5,10),HUE(12,1)
OMIT('**-END-**')
█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█
█ CONFIGURATION █
█───────────────────────────────────────────────────────────█
█ View GIF command: ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ █
█ Run in existing memory: ■ (N/Y) █
█ █
█ The View GIF program must leave the image on the screen █
█ after it exits. Examples for common GIF viewers are: █
█ TPICEM /V:x /E /K (x is the video mode - see docs) █
█ VPIC /A /R (will run in existing memory) █
█ GDS /S /Z0 /X █
█ CSHOW (special case - see docs) █
█───────────────────────────────────────────────────────────█
█ DOS command for F7: ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ █
█ Run in existing memory: ■ (N/Y) █
█ Screen text for F7: ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ █
█───────────────────────────────────────────────────────────█
█ F3-Cancel F9-Accept █
█▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄█
**-END-**
ROW(18,12) PAINT(1,40),HUE(11,1)
ROW(2,12) PAINT(1,40),HUE(11,1)
ROW(4,2) PAINT(13,59),HUE(7,1)
ROW(13,2) PAINT(1,59),HUE(12,1)
ROW(1,1) STRING('█▀{59}█')
ROW(2,1) REPEAT(2),EVERY(12);STRING('█<0{59}>█') .
ROW(3,1) REPEAT(2),EVERY(10);STRING('█─{59}█') .
ROW(4,1) REPEAT(9);STRING('█<0{59}>█') .
ROW(15,1) REPEAT(2);STRING('█<0{59}>█') .
ROW(17,1) STRING('█─{59}█')
ROW(18,1) STRING('█<0{59}>█')
ROW(19,1) STRING('█▄{59}█')
ROW(2,25) STRING('CONFIGURATION')
ROW(5,31) STRING('(N/Y)')
ROW(7,4) STRING('The View GIF program must leave the image on the screen')
ROW(8,4) STRING('after it exits. Examples for common GIF viewers are:')
ROW(9,6) STRING('TPICEM /V:x /E /K (x is the video mode - see docs)')
ROW(10,6) STRING('VPIC /A /R {9}(will run in existing memory)')
ROW(11,6) STRING('GDS /S /Z0 /X')
ROW(12,6) STRING('CSHOW {14}(special case - see docs)')
ROW(15,31) STRING('(N/Y)')
ROW(18,21) STRING('F3-Cancel F9-Accept')
ROW(4,4) STRING('View GIF command:')
COL(22) ENTRY(@S38),USE(F5_CMD),ENH,LFT
ROW(5,4) STRING('Run in existing memory:')
COL(28) ENTRY(@S1),USE(F5_NOYES),ENH,REQ,IMM,UPR
ROW(14,4) STRING('DOS command for F7:')
COL(24) ENTRY(@S36),USE(F7_CMD),HUE(15,1),LFT
ROW(15,4) STRING('Run in existing memory:')
COL(28) ENTRY(@S1),USE(F7_NOYES),HUE(15,1),REQ,IMM,UPR
ROW(16,4) STRING('Screen text for F7:')
COL(24) ENTRY(@S36),USE(F7_TEXT),HUE(15,1)
ROW(17,51) ENTRY,USE(?CFG_ACCEPT)
.
!───────────────────────────────────────────────────────────────────────────────
! RUN DOS COMMAND WINDOW.
!───────────────────────────────────────────────────────────────────────────────
DOS_SCR SCREEN WINDOW(10,74),AT(5,4),HUE(12,1)
OMIT('**-END-**')
█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█
█ EXECUTE █
█────────────────────────────────────────────────────────────────────────█
█ Enter DOS command: █
█ ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ █
█ Run in existing memory: ■ (N/Y) █
█ Pause after execution: ■ (Y/N) █
█────────────────────────────────────────────────────────────────────────█
█ F3-Cancel F9-Do it █
█▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄█
**-END-**
ROW(4,2) PAINT(4,72),HUE(7,1)
ROW(9,2) PAINT(1,72),HUE(11,1)
ROW(2,2) PAINT(1,72),HUE(11,1)
ROW(1,1) STRING('█▀{72}█')
ROW(2,1) REPEAT(3),EVERY(2);STRING('█<0{72}>█') .
ROW(3,1) REPEAT(2),EVERY(5);STRING('█─{72}█') .
ROW(5,1) REPEAT(3),EVERY(2);STRING('█<0{72}>█') .
ROW(10,1) STRING('█▄{72}█')
ROW(2,35) STRING('EXECUTE')
ROW(4,4) STRING('Enter DOS command:')
ROW(6,31) STRING('(N/Y)')
ROW(7,31) STRING('(Y/N)')
ROW(9,27) STRING('F3-Cancel {6}F9-Do it')
ROW(5,4) ENTRY(@S68),USE(F8_CMD),HUE(15,1),REQ,LFT
ROW(6,4) STRING('Run in existing memory:')
COL(28) ENTRY(@S1),USE(F8_NOYES),HUE(15,1),REQ,IMM,UPR
ROW(7,5) STRING('Pause after execution:')
COL(28) ENTRY(@S1),USE(F8_PAUSE),HUE(15,1),REQ,IMM,UPR
ROW(8,3) ENTRY,USE(?DOS_ACCEPT)
.
!───────────────────────────────────────────────────────────────────────────────
! HELP WINDOW.
!───────────────────────────────────────────────────────────────────────────────
HELP_SCR SCREEN WINDOW(5,43),AT(11,20),HUE(12,2)
OMIT('**-END-**')
█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█
█ █
█ █
█ █
█▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄█
**-END-**
ROW(2,2) PAINT(3,41),HUE(14,2)
ROW(1,1) STRING('█▀{41}█')
ROW(2,1) REPEAT(3);STRING('█<0{41}>█') .
ROW(5,1) STRING('█▄{41}█')
.
!═══════════════════════════════════════════════════════════════════════════════
! GLOBAL VARIABLES.
!═══════════════════════════════════════════════════════════════════════════════
CFG_GROUP GROUP !VARIABLES FROM CONFIGURATION FILE
F5_CMD STRING(64) !GIF VIEW COMMAND FOR F5
F5_NOYES STRING('N') !Y=RUNSMALL(), N=RUN()
F7_CMD STRING(127) !DOS COMMAND RUN FOR F7
F7_NOYES STRING('N') !Y=RUNSMALL(), N=RUN()
F7_TEXT STRING(57) !F7 TEXT ON SCREEN
END!GROUP
SAVE_CFG STRING(250) !SAVE CFG_GROUP IF CFG SCREEN IS ABORTED
F5_TEXT STRING(74) !TEXT OF F5 COMMAND FOR SCREEN DISPLAY
F5_CSHOW STRING(2) !MUST ADD '+X' TO GIF FILE FOR COMPUSHOW
CFG_ERROR BYTE !1 IF ANY ERROR READING CONFIG FILE
RANGE SHORT(5) !NO. OF COLOR RANGES (2:255)
REPEAT SHORT !REPEAT COLORS EVERY x COLOR (2:RANGE-1)
NEON STRING('N') !SET EVERY OTHER COLOR TO BLACK (YES/NO)
NEONR BYTE !NEON COLOR RED
NEONG BYTE !NEON COLOR GREEN
NEONB BYTE !NEON COLOR BLUE
SET0 STRING('N') !SET COLOR 0 (YES/NO)
DOSNAME STRING(78) !DOS FILENAME FOR MAP OR CONFIG FILE
PROMPT STRING('Y') !CONFIRM IF SAVE MAP FILENAME EXISTS
GIFNAME STRING(78) !GIF FILENAME AS ENTERED BY USER
F8_GROUP GROUP !VARIABLES FOR F8-DOS COMMAND
F8_CMD STRING(127) !DOS COMMAND RUN FOR F8
F8_NOYES STRING('N') !Y=RUNSMALL(), N=RUN()
F8_PAUSE STRING('Y') !PAUSE AFTER DOS_CMD (Y/N)
END!GROUP
SAVE_F8 STRING(129) !SAVE F8_GROUP IF DOS SCREEN IS ABORTED
RETURNFILE STRING(128) !GIF FILENAME RETURNED BY VERIFILE()
UNIQUE SHORT(5) !SAME AS REPEAT IF REPEAT USED,ELSE RANGE
FIRST BYTE(2) ! 2 IF SET0=N, 1 IF SET0=Y
MAX SHORT(255) !255 IF SET0=N, 256 IF SET0=Y
K SHORT !KEYCODE() OF KEY STRUCK BY USER
BACKINGUP BYTE !1 IF USER HIT UP-ARROW OR SHIFT-TAB
SAVE_PLACE BYTE !SAVE CURRENT SCREEN ENTRY FIELD
I SHORT !LOOP COUNTER
J SHORT !LOOP COUNTER
PALGROUP GROUP !GROUPED FOR ASSIGNMENT STATEMENT
PALR BYTE,DIM(257) ! RED
PALG BYTE,DIM(257) ! GREEN
PALB BYTE,DIM(257) ! BLUE
END!GROUP
SAVEPAL GROUP !SAVE PALETTE FOR COLOR CYCLING
SAVR BYTE,DIM(257) ! RED
SAVG BYTE,DIM(257) ! GREEN
SAVB BYTE,DIM(257) ! BLUE
END!GROUP
NUMPAL SHORT,DIM(257) !PALETTE NUMBER OF COLOR CHANGE
INCREMENT REAL !INCREMENT BETWEEN RANGES (REAL NO.)
!(ALSO USED AS FLAG IF MAP WAS DRAWN YET)
INCR_R REAL !INCREMENT BETWEEN RANGES OF RED
INCR_B REAL !INCREMENT BETWEEN RANGES OF BLUE
INCR_G REAL !INCREMENT BETWEEN RANGES OF GREEN
SPREAD BYTE !NUMBER OF PALETTES BETWEEN NUMPALS
N SHORT !CURRENT PALETTE BEING WORKED ON
NO_CYCLE BYTE !NO. OF COLORS TO CYCLE (1,10,20,...,100)
DIRECTION SHORT(1) !DIRECTION TO CYCLE (1=FORWARD,-1=BACK)
ON_GIF BYTE !SET TO 1 IF NEW_MAP CALLED BY VIEW_GIF
MESSAGE STRING(50) !ERROR MSG RETURNED BY GRAPHICS FUNCTION
DIRGROUP GROUP !USED BY AKADIREC.BIN (length=46)
BYTE ! Attribute, bitmapped
SHORT ! Time (DOS format)
SHORT ! Date (DOS format)
LONG ! Size
STRING(13) ! Name (null terminated)
AKAName STRING(8) ! Name only
AKAExt STRING(3) ! Extension only
LONG ! Clarion standard date
LONG ! Clarion standard time
STRING(4) ! Attr, string (ARHS)
BYTE ! 0=File,1=Sub,2=Pre,3=Cur
END!GROUP !End AKADirec Group
!───────────────────────────────────────────────────────────────────────────────
! DOS FILE STRUCTURE FOR SAVING THE MAP FILE OR READING CONFIGURATION FILE.
!───────────────────────────────────────────────────────────────────────────────
DOSFILE DOS,ASCII,PRE(DOS),NAME(DOSNAME)
RECORD
RECORD STRING(127)
END!RECORD
END!DOS FILE
!═══════════════════════════════════════════════════════════════════════════════
! CODE.
!═══════════════════════════════════════════════════════════════════════════════
CODE
!─────────────────────────────────────────────────────────────────────────────
! COMMENTED OUT FIELDS ARE INITIALIZED BY COMPILER.
!─────────────────────────────────────────────────────────────────────────────
! RANGE = 5
! UNIQUE = RANGE !BE SURE TO INIT IN CASE F5 HIT BEFORE F9
! NEON = 'N'
! SET0 = 'N'
! PROMPT = 'Y'
! F8_NOYES = 'N'
! F8_PAUSE = 'Y'
! DIRECTION = 1 !COLOR CYCLING DIRECTION
!─────────────────────────────────────────────────────────────────────────────
! ONE TIME START UP CODE.
!─────────────────────────────────────────────────────────────────────────────
CLASETBLKMAX(0) !TURN OFF SCREEN BLANKING
OPEN(SCREEN)
DO READ_CONFIG !READ CONFIGURATION FILE
IF F5_CMD
F5_TEXT = CENTER('View GIF command: ' & F5_CMD,74) !FOR SCREEN DISPLAY
ELSE
F5_TEXT = CENTER('View GIF command: (none)',74)
END!IF-ELSE
IF INSTRING('CSHOW',UPPER(F5_CMD),1) !IF RUNNING CSHOW
F5_CSHOW = '+X' ! MUST ADD '+X' TO GIF NAME
ELSE
CLEAR(F5_CSHOW)
END!IF
SCR:MEM_LEFT = MEMORY(0) !DISPLAY MEMORY LEFT
IF NOT VIDISVGA() !IF VGA NOT DETECTED
BEEP(244,38);BEEP(129,88) ! NASTY BEEP
SETHUE(30,0) ! BLINK MESSAGE
SCR:MESSAGE = '!! VGA NOT DETECTED - CONTINUE AT YOUR OWN RISK !!'
SETHUE
END!IF
DISPLAY
DO SET_ALERT !ALERT SCREEN ACTION KEYS
!─────────────────────────────────────────────────────────────────────────────
! MAIN SCREEN LOOP.
!─────────────────────────────────────────────────────────────────────────────
LOOP
ACCEPT
CLEAR(SCR:MESSAGE)
CLEAR(MESSAGE) !CLEAR GIF FILE ERROR
CLEAR(BACKINGUP) !CLEAR BACKING UP FLAG
!───────────────────────────────────────────────────────────────────────────
! HOT KEY LOGIC.
!───────────────────────────────────────────────────────────────────────────
CASE KEYCODE()
!───────────────────────────────────────────────────────────────────────────
! TAB, SHIFT-TAB, ESC, UP-ARROW: NON-STANDARD HANDLING.
!───────────────────────────────────────────────────────────────────────────
OF TAB_KEY !TAB: GO TO NEXT FIELD
UPDATE(?)
OF ESC_KEY !ESC: RESTORE FIELD THEN GO TO PREVIOUS
DISPLAY(?)
IF FIELD() = 1 ! IF ON FIRST FIELD
IF CONFIRM('Y') ! ASK USER IF HE WANTS TO QUIT
RETURN
ELSE
SELECT(?)
END!IF-ELSE
ELSIF FIELD() = ?SET0 AND NEON = 'N'; SELECT(?NEON)
ELSE; SELECT(?-1)
END!IF
CYCLE
OF UP_KEY OROF SHFT_TAB !UP OR SHIFT-TAB: GO TO PREVIOUS FIELD
BACKINGUP = 1
UPDATE(?)
IF FIELD() = 1; SELECT(?)
ELSE; SELECT(?-1)
END!IF
!───────────────────────────────────────────────────────────────────────────
! F - KEYS.
!───────────────────────────────────────────────────────────────────────────
OF F1_KEY !F1: HELP (of sorts)
UPDATE(?)
SELECT(?)
DO HELP
CYCLE
OF F2_KEY !F2: CONFIGURATION
UPDATE(?)
SELECT(?)
DO CONFIGURE
DISPLAY(?F5_TEXT,FIELDS()) ! DISPLAY NEW VALUES (IF ANY)
DO SET_ALERT
CYCLE
OF F3_KEY !F3: RETURN
RETURN
OF F4_KEY !F4: REDISPLAY CURRENT MAP
UPDATE(?)
SELECT(?)
SAVE_PLACE = FIELD() ! RETURN TO SAME FIELD
SELECT ! VERIFY ALL FIELDS THEN GOTO ACCEPT
K=F4_KEY
CYCLE
OF F5_KEY !F5: SHOW GIF
UPDATE(?)
SELECT(?)
SAVE_PLACE = FIELD() ! RETURN TO SAME FIELD
SELECT ! VERIFY ALL FIELDS THEN GOTO ACCEPT
K=F5_KEY
CYCLE
OF F6_KEY !F6: SAVE MAP FILE
UPDATE(?)
SELECT(?)
DO SAVE_MAP
CYCLE
OF F7_KEY !F7: RUN PRE-SET DOS COMMAND
UPDATE(?)
SELECT(?)
IF NOT F7_CMD ! IF USER DIDN'T DEFINE A COMMAND
SCR:MESSAGE = ' NO COMMAND DEFINED - PRESS F2 TO DEFINE'
BEEP
ELSE
EXEC_EXT(F7_CMD,F7_NOYES,'N') ! RUN COMMAND, DON'T PAUSE AFTERWARDS
END!IF-ELSE
CYCLE
OF F8_KEY !F8: RUN ANY DOS COMMAND
UPDATE(?)
SELECT(?)
DO DOS_CMD
DO SET_ALERT
CYCLE
OF F9_KEY !F9: CREATE NEW MAP
UPDATE(?)
SELECT(?)
SAVE_PLACE = FIELD() ! RETURN TO SAME FIELD
SELECT ! VERIFY ALL FIELDS THEN GOTO ACCEPT
CYCLE
END!CASE KEYCODE()
!───────────────────────────────────────────────────────────────────────────
! FIELD VALIDATION.
!───────────────────────────────────────────────────────────────────────────
CASE FIELD()
OF ?RANGE
IF RANGE < 2 OR RANGE > 255
SCR:MESSAGE = CENTER('MUST BE 2 - 255',50)
BEEP
SELECT(?)
END!IF
IF REPEAT >= RANGE
ERASE(?REPEAT)
END!IF
OF ?REPEAT
IF REPEAT = 1 OR REPEAT >= RANGE
SCR:MESSAGE = 'MUST BE BETWEEN 2 AND RANGE-1, OR 0 FOR NO REPEAT'
BEEP
SELECT(?)
END!IF
OF ?NEON
IF NEON <> 'N' AND NEON <> 'Y'
SCR:MESSAGE = CENTER('MUST BE Y (YES) OR N (NO)',50)
BEEP
SELECT(?)
CYCLE
END!IF
IF NEON = 'N' AND NOT BACKINGUP
SELECT(?SET0)
END!IF
OF ?NEONR
IF NEONR > 63
SCR:MESSAGE = CENTER('MUST BE 0 - 63',50)
BEEP
SELECT(?)
END!IF
OF ?NEONG
IF NEONG > 63
SCR:MESSAGE = CENTER('MUST BE 0 - 63',50)
BEEP
SELECT(?)
END!IF
OF ?NEONB
IF NEONB > 63
SCR:MESSAGE = CENTER('MUST BE 0 - 63',50)
BEEP
SELECT(?)
END!IF
OF ?SET0
IF SET0 <> 'N' AND SET0 <> 'Y'
SCR:MESSAGE = CENTER('MUST BE Y (YES) OR N (NO)',50)
BEEP
SELECT(?)
CYCLE
END!IF-ELSE
IF SET0 = 'N'
FIRST = 2
MAX = 255
ELSIF SET0 = 'Y'
FIRST = 1
MAX = 256
END!IF-ELSE
IF BACKINGUP AND NEON = 'N'
SELECT(?NEON)
END!IF
OF ?PROMPT
IF PROMPT <> 'N' AND PROMPT <> 'Y'
SCR:MESSAGE = CENTER('MUST BE Y (YES) OR N (NO)',50)
BEEP
SELECT(?)
END!IF
OF ?GIFNAME
IF KEYCODE() AND NOT BACKINGUP !IF NOT F4,F5,F9 AND NOT UP-ARROW OR
SELECT(?) ! SHIFT-TAB, STAY ON LAST ENTRY FIELD
END!IF
!───────────────────────────────────────────────────────────────────────────
! ACCEPT WILL BE SELECTED AFTER F4, F5, OR F9.
!───────────────────────────────────────────────────────────────────────────
OF ?ACCEPT
IF REPEAT !SET MAX UNIQUE COLORS
UNIQUE = REPEAT
ELSE
UNIQUE = RANGE
END!IF-ELSE
CASE K
!─────────────────────────────────────────────────────────────────────────
! F4: DISPLAY EXISTING MAP.
!─────────────────────────────────────────────────────────────────────────
OF F4_KEY
CLOSE(SCREEN)
IF NOT INCREMENT !IF NO MAP WAS YET CREATED
DO DEFAULT_MAP ! READ DEFAULT PALETTE FROM VIDEO CARD
END!IF
DO VIEW_MAP !DISPLAY THE MAP
DO WAIT4KEY !WAIT FOR KEYSTROKE
SETVMODE(3) !RESET TO TEXT MODE
OPEN(SCREEN) !REOPEN SCREEN
SCR:MEM_LEFT = MEMORY(0) !REDISPLAY MEMORY LEFT
DISPLAY
SELECT(SAVE_PLACE) !RETURN TO SAME FIELD
IF MESSAGE !IF ERROR VIEWING GIF FILE
SCR:MESSAGE = CENTER(MESSAGE,50)
BEEP
SELECT(?GIFNAME)
END!IF
CYCLE
!─────────────────────────────────────────────────────────────────────────
! F5: DISPLAY GIF WITH EXISTING MAP.
!─────────────────────────────────────────────────────────────────────────
OF F5_KEY
SELECT(?) !CANCEL AUTOSELECT IN CASE OF ERROR
I = VERIFILE() !CHECK FILE OR SHOW TABLE OF FILES
SCR:MEM_LEFT = MEMORY(0) !REDISPLAY MEMORY LEFT
DO SET_ALERT !RESET MAIN SCREEN ALERT KEYS
IF I = 1 !IF USER ABORTED TABLE
SELECT(SAVE_PLACE) ! RETURN TO SAME FIELD
CYCLE
ELSIF I = 2 !IF NO FILES IN DIRECTORY MATCH SPEC
SCR:MESSAGE = CENTER('NO MATCHING FILES IN DIRECTORY',50)
BEEP
SELECT(?GIFNAME)
CYCLE
ELSIF I = 3 ! IF BAD PATH
SCR:MESSAGE = CENTER('INVALID PATH\FILENAME',50)
BEEP
SELECT(?GIFNAME)
CYCLE
END!IF
GIFNAME = RETURNFILE ! DISPLAY FILE RETURNED BY VERIFILE()
DISPLAY(?GIFNAME)
CLOSE(SCREEN)
IF NOT INCREMENT ! IF NO MAP WAS YET CREATED
DO DEFAULT_MAP ! READ DEFAULT PALETTE FROM VIDEO CARD
END!IF
DO VIEW_GIF ! DISPLAY THE GIF, ETC.
SETVMODE(3) ! RESET TO TEXT MODE
OPEN(SCREEN) ! REOPEN SCREEN
SCR:MEM_LEFT = MEMORY(0) ! REDISPLAY MEMORY LEFT
DISPLAY
SELECT(SAVE_PLACE) ! RETURN TO SAME FIELD
IF MESSAGE ! IF ERROR VIEWING GIF FILE
SCR:MESSAGE = CENTER(MESSAGE,50)
BEEP
SELECT(?GIFNAME)
END!IF
CYCLE
END!CASE K
!─────────────────────────────────────────────────────────────────────────
! F9: CREATE AND DISPLAY NEW MAP.
!─────────────────────────────────────────────────────────────────────────
CLOSE(SCREEN)
DO NEW_MAP !DRAW AND DISPLAY NEW MAP
DO WAIT4KEY !WAIT FOR KEYSTROKE
SETVMODE(3) !RESET TO TEXT MODE
OPEN(SCREEN) !REOPEN SCREEN
SCR:MEM_LEFT = MEMORY(0) !REDISPLAY MEMORY LEFT
DISPLAY
SELECT(SAVE_PLACE) !RETURN TO SAME FIELD
IF MESSAGE !IF ERROR VIEWING GIF FILE
SCR:MESSAGE = CENTER(MESSAGE,50)
BEEP
SELECT(?GIFNAME)
END!IF
END!CASE FIELD()
END!SCREEN LOOP
!───────────────────────────────────────────────────────────────────────────────
! SET ALERT KEYS FOR MAIN SCREEN.
!───────────────────────────────────────────────────────────────────────────────
SET_ALERT ROUTINE
ALERT
ALERT(ESC_KEY)
ALERT(TAB_KEY)
ALERT(SHFT_TAB)
ALERT(UP_KEY)
ALERT(F1_KEY,F9_KEY) !ALERT F1 THROUGH F9
EXIT
!═══════════════════════════════════════════════════════════════════════════════
! ROUTINE TO CREATE AND DISPLAY A NEW MAP.
!═══════════════════════════════════════════════════════════════════════════════
NEW_MAP ROUTINE
!─────────────────────────────────────────────────────────────────────────────
! SET TO 320x200x256 MODE UNLESS VIEWING GIF.
!─────────────────────────────────────────────────────────────────────────────
IF NOT ON_GIF !IF NOT VIEWING GIF
SETVMODE(19) ! SET TO 320x200x256
!!! LINE(32,0,32,199,0) ! DISPLAY COLOR 0
END!IF
!─────────────────────────────────────────────────────────────────────────────
! IF NOT USING COLOR 0, SET IT TO BLACK.
!─────────────────────────────────────────────────────────────────────────────
IF SET0 = 'N'
PALR[1] = 0
PALG[1] = 0
PALB[1] = 0
SETCOLOR(0,0,0,0)
END!IF
!─────────────────────────────────────────────────────────────────────────────
! SET RANDOM COLOR FOR COLOR 1, OR SET TO NEONx IF NEON REQUESTED.
!─────────────────────────────────────────────────────────────────────────────
IF NEON = 'Y'
PALR[FIRST] = NEONR
PALG[FIRST] = NEONG
PALB[FIRST] = NEONB
ELSE
PALR[FIRST] = RANDOM(0,63)
PALG[FIRST] = RANDOM(0,63)
PALB[FIRST] = RANDOM(0,63)
END!IF-ELSE
PALR[257] = PALR[FIRST] !257 WILL CAUSE WRAP AROUND TO FIRST
PALG[257] = PALG[FIRST]
PALB[257] = PALB[FIRST]
SETCOLOR(FIRST-1,PALR[FIRST],PALG[FIRST],PALB[FIRST])
NUMPAL[1] = FIRST
IF NOT ON_GIF !IF NOT VIEWING GIF
LINE(FIRST+31,0,FIRST+31,199,FIRST-1) !DRAW A LINE
END!IF
!─────────────────────────────────────────────────────────────────────────────
! FIND THE PALETTE NUMBERS WHERE THE COLOR CHANGES AND SET A RANDOM COLOR
! FOR EACH.
!─────────────────────────────────────────────────────────────────────────────
INCREMENT = MAX/RANGE !SET REAL NO. INCREMENT
LOOP I = 2 TO RANGE !SET REMAINING RANDOM COLORS
NUMPAL[I] = FIRST + ROUND(INCREMENT * (I-1),1)
IF I > UNIQUE !IF REPEAT, SET TO PREVIOUS COLOR
PALR[NUMPAL[I]] = PALR[NUMPAL[I - REPEAT]]
PALG[NUMPAL[I]] = PALG[NUMPAL[I - REPEAT]]
PALB[NUMPAL[I]] = PALB[NUMPAL[I - REPEAT]]
ELSIF NEON = 'Y' AND I%2 !IF NEON, SET EVERY OTHER COLOR TO
PALR[NUMPAL[I]] = NEONR ! REQUESTED COLOR
PALG[NUMPAL[I]] = NEONG
PALB[NUMPAL[I]] = NEONB
ELSE !IF NORMAL COLOR CHANGE
PALR[NUMPAL[I]] = RANDOM(0,63) ! SET TO A NEW RANDOM COLOR
PALG[NUMPAL[I]] = RANDOM(0,63)
PALB[NUMPAL[I]] = RANDOM(0,63)
END!IF-ELSE
SETCOLOR(NUMPAL[I]-1,PALR[NUMPAL[I]],PALG[NUMPAL[I]],PALB[NUMPAL[I]])
IF NOT ON_GIF !IF NOT VIEWING GIF
LINE(NUMPAL[I]+31,0,NUMPAL[I]+31,199,NUMPAL[I]-1) !DRAW A LINE
END!IF
END!LOOP
!─────────────────────────────────────────────────────────────────────────────
! SET THE IN-BETWEEN COLORS FOR EACH RANGE.
!─────────────────────────────────────────────────────────────────────────────
NUMPAL[RANGE + 1] = 257 !SO LAST COLOR BLENDS INTO 1ST
LOOP I = 2 TO RANGE + 1
SPREAD = NUMPAL[I] - NUMPAL[I-1]
INCR_R = (PALR[NUMPAL[I]] - PALR[NUMPAL[I-1]]) / SPREAD
INCR_G = (PALG[NUMPAL[I]] - PALG[NUMPAL[I-1]]) / SPREAD
INCR_B = (PALB[NUMPAL[I]] - PALB[NUMPAL[I-1]]) / SPREAD
LOOP J = 1 TO SPREAD - 1
N = NUMPAL[I-1] + J
PALR[N] = PALR[NUMPAL[I-1]] + ROUND(INCR_R * J,1)
PALG[N] = PALG[NUMPAL[I-1]] + ROUND(INCR_G * J,1)
PALB[N] = PALB[NUMPAL[I-1]] + ROUND(INCR_B * J,1)
SETCOLOR(N-1,PALR[N],PALG[N],PALB[N])
IF NOT ON_GIF !IF NOT VIEWING GIF
LINE(N+31,0,N+31,199,N-1) ! DRAW A LINE
END!IF
END!LOOP
END!LOOP
! !─────────────────────────────────────────────────────────────────────────────
! ! SET THE LAST RANGE SO IT BLENDS INTO COLOR 1.
! !─────────────────────────────────────────────────────────────────────────────
! SPREAD = 257 - NUMPAL[RANGE]
! INCR_R = (PALR[FIRST] - PALR[NUMPAL[RANGE]]) / SPREAD
! INCR_G = (PALG[FIRST] - PALG[NUMPAL[RANGE]]) / SPREAD
! INCR_B = (PALB[FIRST] - PALB[NUMPAL[RANGE]]) / SPREAD
! LOOP J = 1 TO SPREAD - 1
! N = NUMPAL[RANGE] + J
! PALR[N] = PALR[NUMPAL[RANGE]] + ROUND(INCR_R * J,1)
! PALG[N] = PALG[NUMPAL[RANGE]] + ROUND(INCR_G * J,1)
! PALB[N] = PALB[NUMPAL[RANGE]] + ROUND(INCR_B * J,1)
! SETCOLOR(N-1,PALR[N],PALG[N],PALB[N])
! IF NOT ON_GIF !IF NOT VIEWING GIF
! LINE(N+31,0,N+31,199,N-1)
! END!IF
! END!LOOP
EXIT
!═══════════════════════════════════════════════════════════════════════════════
! ROUTINE TO REDISPLAY THE CURRENT MAP.
!═══════════════════════════════════════════════════════════════════════════════
VIEW_MAP ROUTINE
SETVMODE(19) !SET TO 320x200x256
LOOP I = 1 TO 256
SETCOLOR(I-1,PALR[I],PALG[I],PALB[I])
LINE(I+31,0,I+31,199,I-1)
END!LOOP
!═══════════════════════════════════════════════════════════════════════════════
! THIS ROUTINE IS CALLED WHENEVER A MAP IS DISPLAYED (AFTER NEW_MAP OR VIEW_MAP)
! IF F9 OR <ENTER> IS HIT A NEW MAP IS DRAWN; IF F5 THE GIF FILE IS DISPLAYED;
! +,- CHANGES DIRECTION OF COLOR CYCLING (BUT DOESN'T COLOR CYCLE);
! <,>,1,2,...0 CYCLES COLORS. ANY OTHER KEY RETURNS.
!═══════════════════════════════════════════════════════════════════════════════
WAIT4KEY ROUTINE
LOOP
ASK
K = KEYCODE()
IF K = ENTER_KEY |
OR K = F9_KEY
DO NEW_MAP
ELSIF K = GPLUS_KEY |
OR K = PLUS_KEY
DIRECTION = 1
BEEP(2960,10);BEEP(0,6);BEEP(3520,10)
ELSIF K = GMINUS_KEY |
OR K = MINUS_KEY
DIRECTION = -1
BEEP(3520,10);BEEP(0,6);BEEP(2960,10)
ELSIF (K >= 48 AND K <= 57) |
OR K = COMMA_KEY |
OR K = PERIOD_KEY |
OR K = LEFT_ANGLE |
OR K = RIGHT_ANGLE
DO COLOR_CYCLE
ELSIF K = F5_KEY
IF NOT FILEXISTS(GIFNAME)
MESSAGE = 'FILE NOT FOUND'
ELSE
DO VIEW_GIF
END!IF-ELSE
IF MESSAGE THEN EXIT. !EXIT IF ERROR VIEWING GIF
DO VIEW_MAP !REDISPLAY MAP
ELSE
EXIT
END!IF-ELSE
END!LOOP
!═══════════════════════════════════════════════════════════════════════════════
! ROUTINE TO DISPLAY A GIF PICTURE WITH THE CURRENT MAP PALETTE.
!═══════════════════════════════════════════════════════════════════════════════
VIEW_GIF ROUTINE
!─────────────────────────────────────────────────────────────────────────────
! SHELL TO GIF VIEWER. GIF VIEWER MUST LEAVE IMAGE ON SCREEN AFTER RETURNING
! AND NOT RESET VIDEO MODE.
!─────────────────────────────────────────────────────────────────────────────
IF NOT F5_CMD !IF USER DIDN'T DEFINE A COMMAND
MESSAGE = 'NO COMMAND DEFINED - PRESS F2 TO DEFINE' ! SET ERROR MESSAGE
EXIT ! EXIT
END!IF
IF F5_NOYES = 'N'
RUN(CLIP(F5_CMD) & ' ' & CLIP(GIFNAME) & F5_CSHOW)
ELSE
RUNSMALL(CLIP(F5_CMD) & ' ' & CLIP(GIFNAME) & F5_CSHOW)
END!IF-ELSE
IF RUNCODE() = -4 !IF .TMP FILE COULDN'T BE CREATED
MESSAGE = 'COULDN''T CREATE .TMP MEMORY IMAGE FILE'
EXIT
END!IF
!!! THE FOLLOWING CODE WAS DELETED BECAUSE IT NEVER SEEMED TO RETURN ANYTHING
! IF F5_ERROR AND ERRORCODE() !IF USER WANTS ERRORS & PGM RETURNED CODE
! MESSAGE = ERROR() ! SET ERROR MESSAGE
! EXIT ! EXIT
! END!IF
!─────────────────────────────────────────────────────────────────────────────
! THE GIF WILL BE DISPLAYED WITH ITS OWN COLORS SO THE COLORS MUST BE RESET TO
! THE CURRENT MAP.
!─────────────────────────────────────────────────────────────────────────────
LOOP I = 1 TO 256
SETCOLOR(I-1,PALR[I],PALG[I],PALB[I])
END!LOOP
!─────────────────────────────────────────────────────────────────────────────
! WHILE GIF IMAGE IS DISPLAYED USER CAN HIT F9 OR <ENTER> TO CREATE A NEW MAP;
! +,- CHANGES DIRECTION OF COLOR CYCLING; <,>,1,2,...,0 CYCLES COLORS;
! ANY OTHER KEY EXITS.
!─────────────────────────────────────────────────────────────────────────────
ON_GIF = 1 !FOR USE BY NEW_MAP
LOOP
ASK
K = KEYCODE()
IF K = F9_KEY |
OR K = ENTER_KEY
DO NEW_MAP
ELSIF K = GPLUS_KEY |
OR K = PLUS_KEY
DIRECTION = 1
BEEP(2960,10);BEEP(0,6);BEEP(3520,10)
ELSIF K = GMINUS_KEY |
OR K = MINUS_KEY
DIRECTION = -1
BEEP(3520,10);BEEP(0,6);BEEP(2960,10)
ELSIF (K >= 48 AND K <= 57) |
OR K = COMMA_KEY |
OR K = PERIOD_KEY |
OR K = LEFT_ANGLE |
OR K = RIGHT_ANGLE
DO COLOR_CYCLE
ELSE
CLEAR(ON_GIF)
EXIT
END!IF-ELSE
END!LOOP
EXIT
!═══════════════════════════════════════════════════════════════════════════════
! COLOR CYCLE WHILE VIEWING A MAP OR VIEWING A GIF.
!═══════════════════════════════════════════════════════════════════════════════
COLOR_CYCLE ROUTINE
!─────────────────────────────────────────────────────────────────────────────
! DETERMINE NO. OF COLORS TO CYCLE AND DIRECTION BASED ON THE KEY USER HIT.
!─────────────────────────────────────────────────────────────────────────────
IF K = LEFT_ANGLE | !'<'
OR K = COMMA_KEY !','
DIRECTION = -1
NO_CYCLE = 1
ELSIF K = RIGHT_ANGLE | !'>'
OR K = PERIOD_KEY !'.'
DIRECTION = 1
NO_CYCLE = 1
ELSIF K = 48 !'0'
NO_CYCLE = 100
ELSE !'1' - '9'
NO_CYCLE = (K - 48) * 10
END!IF-ELSE
SAVEPAL = PALGROUP !SAVE EXISTING COLORS
!─────────────────────────────────────────────────────────────────────────────
! RECALC COLOR MAP BY ROTATING COLORS FORWARD.
!─────────────────────────────────────────────────────────────────────────────
IF DIRECTION = 1
LOOP I = FIRST TO 256 - NO_CYCLE
J = I + NO_CYCLE
PALR[I] = SAVR[J]
PALG[I] = SAVG[J]
PALB[I] = SAVB[J]
SETCOLOR(I-1,PALR[I],PALG[I],PALB[I])
END!LOOP
J = FIRST - 1
LOOP I = 257 - NO_CYCLE TO 256
J += 1
PALR[I] = SAVR[J]
PALG[I] = SAVG[J]
PALB[I] = SAVB[J]
SETCOLOR(I-1,PALR[I],PALG[I],PALB[I])
END!LOOP
!─────────────────────────────────────────────────────────────────────────────
! RECALC COLOR MAP BY ROTATING COLORS BACKWARD.
!─────────────────────────────────────────────────────────────────────────────
ELSE !DIRECTION = -1
LOOP I = FIRST TO FIRST + NO_CYCLE - 1
J = MAX - NO_CYCLE + I
PALR[I] = SAVR[J]
PALG[I] = SAVG[J]
PALB[I] = SAVB[J]
SETCOLOR(I-1,PALR[I],PALG[I],PALB[I])
END!LOOP
LOOP I = FIRST + NO_CYCLE TO 256
J = I - NO_CYCLE
PALR[I] = SAVR[J]
PALG[I] = SAVG[J]
PALB[I] = SAVB[J]
SETCOLOR(I-1,PALR[I],PALG[I],PALB[I])
END!LOOP
END!IF-ELSE
CLEAR(NUMPAL[]) !NUMPAL ARRAY NO LONGER VALID
EXIT
!═══════════════════════════════════════════════════════════════════════════════
! SAVE CURRENT PALETTE TO AN ASCII FRACTINT MAP FILE.
!═══════════════════════════════════════════════════════════════════════════════
SAVE_MAP ROUTINE
!─────────────────────────────────────────────────────────────────────────────
! CREATE DOS FILE, CONFIRM IF FILE ALREADY EXISTS.
!─────────────────────────────────────────────────────────────────────────────
SCR:MESSAGE = CENTER('PLEASE WAIT . . .',50)
OPEN(DOSFILE)
IF NOT ERRORCODE() !IF FILE EXISTS
CLOSE(DOSFILE)
IF PROMPT = 'Y' !AND USER WANTS TO BE PROMPTED
CLEAR(SCR:MESSAGE)
IF NOT CONFIRM(' ') ! AND DOESN'T CONFIRM
SELECT(?DOSNAME)
EXIT ! RETURN TO MAIN SCREEN
END!IF
SCR:MESSAGE = CENTER('PLEASE WAIT . . .',50)
END!IF
ELSIF ERRORCODE() <> 2 !IF ERROR OTHER THAN FILE NOT FOUND
SCR:MESSAGE = CENTER(ERROR(),50)
CLOSE(DOSFILE) ! IN CASE FILE IS READ ONLY
BEEP
SELECT(?DOSNAME)
EXIT
END!IF-ELSE
CREATE(DOSFILE) !CREATE OR EMPTY FILE
IF ERRORCODE()
SCR:MESSAGE = CENTER(ERROR(),50)
BEEP
SELECT(?DOSNAME)
EXIT
END!IF
!─────────────────────────────────────────────────────────────────────────────
! WRITE EACH OF THE 256 COLORS TO THE FILE.
! NOTE THAT EACH PALETTE NUMBER MUST BE MULTIPLIED BY 4.
! A '<' IS PRINTED NEXT TO EACH COLOR CHANGE UNLESS THERE HAS BEEN COLOR
! CYCLING IN WHICH CASE THIS IS NOT KEPT TRACK OF.
!─────────────────────────────────────────────────────────────────────────────
SCR:MESSAGE = CENTER('WRITING FILE . . .',50)
J = 1
LOOP I = 1 TO 256
DOS:RECORD = FORMAT(PALR[I] * 4,@N3) |
& FORMAT(PALG[I] * 4,@N4) |
& FORMAT(PALB[I] * 4,@N4)
IF I = NUMPAL[J]
DOS:RECORD = CLIP(DOS:RECORD) & ' <<'
J += 1
END!IF
ADD(DOSFILE)
END!LOOP
CLOSE(DOSFILE)
SCR:MESSAGE = CENTER('FILE WRITTEN',50)
EXIT
!═══════════════════════════════════════════════════════════════════════════════
! CONFIGURATION SCREEN - SELECT F5 VIEW COMMAND AND F7 DOS COMMAND.
!═══════════════════════════════════════════════════════════════════════════════
CONFIGURE ROUTINE
OPEN(CFG_SCR)
SAVE_CFG = CFG_GROUP !SAVE CURRENT VALUES IN CASE OF ABORT
DISPLAY !DISPLAY CURRENT VALUES
ALERT
ALERT(ESC_KEY)
ALERT(TAB_KEY)
ALERT(SHFT_TAB)
ALERT(UP_KEY)
ALERT(F3_KEY)
ALERT(F9_KEY)
LOOP
ACCEPT
CLEAR(BACKINGUP)
!───────────────────────────────────────────────────────────────────────────
! HOT KEY LOGIC.
!───────────────────────────────────────────────────────────────────────────
CASE KEYCODE()
OF TAB_KEY !TAB: GO TO NEXT FIELD
UPDATE(?)
OF ESC_KEY !ESC: RESTORE FIELD THEN GO TO PREVIOUS
DISPLAY(?)
IF FIELD() = 1 ! IF ON FIRST FIELD
CLOSE(CFG_SCR)
CFG_GROUP = SAVE_CFG ! RESTORE ORIGINAL VALUES
EXIT ! EXIT
ELSE
SELECT(?-1)
END!IF
CYCLE
OF UP_KEY OROF SHFT_TAB !UP OR SHIFT-TAB: GO TO PREVIOUS FIELD
BACKINGUP = 1
UPDATE(?)
IF FIELD() = 1; SELECT(?)
ELSE; SELECT(?-1)
END!IF
OF F3_KEY !F3: CANCEL
CLOSE(CFG_SCR)
CFG_GROUP = SAVE_CFG ! RESTORE ORIGINAL VALUES
EXIT
OF F9_KEY !F9: ACCEPT
UPDATE(?)
SELECT(?)
SELECT
CYCLE
END!CASE
!───────────────────────────────────────────────────────────────────────────
! FIELD VALIDATION.
!───────────────────────────────────────────────────────────────────────────
CASE FIELD()
OF ?F5_NOYES
IF F5_NOYES <> 'N' AND F5_NOYES <> 'Y'
BEEP
SELECT(?)
END!IF
OF ?F7_NOYES
IF F7_NOYES <> 'N' AND F7_NOYES <> 'Y'
BEEP
SELECT(?)
END!IF
OF FIELDS() - 1 !CAN'T USE '?F7_TEXT' (ALSO ON MAIN SCR)
IF KEYCODE() AND NOT BACKINGUP !IF NOT F9 AND NOT UP-ARROW OR SHIFT-TAB
SELECT(?) ! STAY ON LAST ENTRY FIELD
END!IF
OF ?CFG_ACCEPT
CLOSE(CFG_SCR)
IF F5_CMD
F5_TEXT = CENTER('View GIF command: ' & F5_CMD,74) !FOR SCREEN DISPLAY
ELSE
F5_TEXT = CENTER('View GIF command: (none)',74)
END!IF-ELSE
IF INSTRING('CSHOW',UPPER(F5_CMD),1) !IF RUNNING CSHOW
F5_CSHOW = '+X' ! MUST ADD '+X' TO GIF NAME
ELSE
CLEAR(F5_CSHOW)
END!IF
EXIT
END!CASE
END!LOOP
EXIT
!═══════════════════════════════════════════════════════════════════════════════
! RUN EXTERNAL DOS COMMAND.
!═══════════════════════════════════════════════════════════════════════════════
DOS_CMD ROUTINE
OPEN(DOS_SCR)
SAVE_F8 = F8_GROUP !SAVE CURRENT VALUES IN CASE OF ABORT
DISPLAY !DISPLAY CURRENT VALUES
ALERT
ALERT(ESC_KEY)
ALERT(TAB_KEY)
ALERT(SHFT_TAB)
ALERT(UP_KEY)
ALERT(F3_KEY)
ALERT(F9_KEY)
LOOP
ACCEPT
CLEAR(BACKINGUP)
!───────────────────────────────────────────────────────────────────────────
! HOT KEY LOGIC.
!───────────────────────────────────────────────────────────────────────────
CASE KEYCODE()
OF TAB_KEY !TAB: GO TO NEXT FIELD
UPDATE(?)
OF ESC_KEY !ESC: RESTORE FIELD THEN GO TO PREVIOUS
DISPLAY(?)
IF FIELD() = 1 ! IF ON FIRST FIELD
CLOSE(DOS_SCR)
F8_GROUP = SAVE_F8 ! RESTORE ORIGINAL VALUES
EXIT ! EXIT
ELSE
SELECT(?-1)
END!IF
CYCLE
OF UP_KEY OROF SHFT_TAB !UP OR SHIFT-TAB: GO TO PREVIOUS FIELD
BACKINGUP = 1
UPDATE(?)
IF FIELD() = 1; SELECT(?)
ELSE; SELECT(?-1)
END!IF
OF F3_KEY !F3: CANCEL
CLOSE(DOS_SCR)
F8_GROUP = SAVE_F8 ! RESTORE ORIGINAL VALUES
EXIT
OF F9_KEY !F9: ACCEPT
UPDATE(?)
SELECT(?)
SELECT
CYCLE
END!CASE
!───────────────────────────────────────────────────────────────────────────
! FIELD VALIDATION.
!───────────────────────────────────────────────────────────────────────────
CASE FIELD()
OF ?F8_NOYES
IF F8_NOYES <> 'N' AND F8_NOYES <> 'Y'
BEEP
SELECT(?)
END!IF
OF ?F8_PAUSE
IF F8_PAUSE<> 'N' AND F8_PAUSE <> 'Y'
BEEP
SELECT(?)
CYCLE
END!IF
IF KEYCODE() AND NOT BACKINGUP
SELECT(?)
END!IF
OF ?DOS_ACCEPT
UPDATE(?)
! SELECT(?)
CLOSE(DOS_SCR)
EXEC_EXT(F8_CMD,F8_NOYES,F8_PAUSE)
EXIT
END!CASE
END!LOOP
EXIT
!═══════════════════════════════════════════════════════════════════════════════
! HELP SCREEN.
!═══════════════════════════════════════════════════════════════════════════════
HELP ROUTINE
I = RANDOM(1,4)
OPEN(HELP_SCR)
BEEP(2960,16)
CASE I
OF 1
SHOW(13,23,'You expect help in a free program ?!?')
OF 2
SHOW(13,31,'For Help, Dial 9-1-1')
OF 3
SHOW(12,25,'This program is totally intuitive')
SHOW(13,25,'How could you possibly need help?')
SHOW(14,27,'You really hurt my feelings!')
OF 4
SHOW(12,29,'I''d like to help you out')
SHOW(14,28,'Which way did you come in?')
END!CASE
ASK
CLOSE(HELP_SCR)
EXIT
!═══════════════════════════════════════════════════════════════════════════════
! THIS ROUTINE READS THE VIDEO CARD'S DEFAULT PALETTE. IT IS ONLY CALLED IF THE
! USER HITS F4 (VIEW MAP) OR F5 (VIEW GIF) BEFORE A MAP IS CREATED.
! IT IS NOT CALLED AT BEGINNING OF PROGRAM BECAUSE IT TAKES A LONG TIME.
!═══════════════════════════════════════════════════════════════════════════════
DEFAULT_MAP ROUTINE
SETVMODE(19) !MUST FIRST SET TO 320x200x256
LOOP I = 0 TO 255
PALR[I+1] = RED(I)
PALG[I+1] = GREEN(I)
PALB[I+1] = BLUE(I)
END!LOOP
INCREMENT = 1 !SET FLAG THAT A MAP EXISTS
! SETVMODE(3)
EXIT
!═══════════════════════════════════════════════════════════════════════════════
! READ CONFIGURATION FILE (FIMAPS.CFG).
!═══════════════════════════════════════════════════════════════════════════════
READ_CONFIG ROUTINE
DOSNAME = 'FIMAPS.CFG'
IF NOT FILEXISTS(DOSNAME) !IF IT'S NOT IN CURRENT DIRECTORY
DOSNAME = ENVPROGPATH() & DOSNAME ! LOOK IN THE EXE DIRECTORY
END!IF
OPEN(DOSFILE)
IF NOT ERRORCODE() | !IF NO ERRORS
OR ERRORCODE() = 67 !OR READ ONLY
! SCR:MESSAGE = CENTER('PLEASE WAIT - READING FIMAPS.CFG',50)
SET(DOSFILE)
DO NEXT_CFG !READ F5 COMMAND
F5_CMD = DOS:RECORD
DO NEXT_CFG !READ F5 RUN IN EXISTING MEMORY (N/Y)
DOS:RECORD = UPPER(DOS:RECORD)
IF DOS:RECORD = 'N' OR DOS:RECORD = 'Y'
F5_NOYES = DOS:RECORD
ELSIF DOS:RECORD
CFG_ERROR = 1
END!IF-ELSE
DO NEXT_CFG !READ F7 COMMAND
F7_CMD = DOS:RECORD
F7_TEXT = F7_CMD
DO NEXT_CFG !READ F7 RUN IN EXISTING MEMORY (N/Y)
DOS:RECORD = UPPER(DOS:RECORD)
IF DOS:RECORD = 'N' OR DOS:RECORD = 'Y'
F7_NOYES = DOS:RECORD
ELSIF DOS:RECORD
CFG_ERROR = 1
END!IF-ELSE
DO NEXT_CFG !READ F7 SCREEN TEXT
F7_TEXT = DOS:RECORD
END!IF FIMAPS.CFG READ
CLOSE(DOSFILE)
CLEAR(DOSNAME)
IF CFG_ERROR
SCR:MESSAGE = ' ERROR IN FIMAPS.CFG - USING INTERNAL DEFAULTS'
BEEP
END!IF
EXIT
!───────────────────────────────────────────────────────────────────────────────
! READ NEXT RECORD FROM FIMAPS.CFG SKIPPING ';' COMMENT LINES.
! IF EOF, CLEAR DOS:RECORD AND PRETEND TO READ ENTIRE FILE ANYWAY,
! ANY REMAINING OPTIONS WILL BE SET TO INTERNAL DEFAULTS.
!───────────────────────────────────────────────────────────────────────────────
NEXT_CFG ROUTINE
LOOP
IF EOF(DOSFILE) OR ERRORCODE()
CLEAR(DOS:RECORD)
EXIT
END!IF
NEXT(DOSFILE)
DOS:RECORD = LEFT(DOS:RECORD) !ALL RECORDS ARE LEFT JUSTIFIED
IF SUB(DOS:RECORD,1,1) <> ';' !SKIP ANY LINE BEGINNING WITH ';'
EXIT
END!IF
END!LOOP
EXIT
!╔═════════════════════════════════════════════════════════════════════════════╗
!║ FUNCTION TO RETURN USER CONFIRMATION FOR OVERWRITING MAP FILE OR EXITING ║
!║ PROGRAM. RETURNS 'Y' OR BLANK. ║
!╚═════════════════════════════════════════════════════════════════════════════╝
CONFIRM FUNCTION(DEFAULT)
CON_SCR SCREEN WINDOW(3,37),AT(9,25),HUE(12,4)
OMIT('**-END-**')
█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█
█ File Exists - Overwrite? N Y/N █
█▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄█
**-END-**
ROW(2,2) PAINT(1,35),HUE(11,4)
ROW(2,29) PAINT(1,1),HUE(11,0)
ROW(1,1) STRING('█▀{35}█')
ROW(2,1) STRING('█<0{35}>█')
ROW(3,1) STRING('█▄{35}█')
ROW(2,4) STRING('File Exists - Overwrite?')
COL(29) STRING('N')
COL(32) STRING('Y/N')
.
EXIT_SCR SCREEN WINDOW(3,18),AT(9,32),HUE(12,4)
OMIT('**-END-**')
█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█
█ Exit? Y Y/N █
█▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄█
**-END-**
ROW(2,2) PAINT(1,16),HUE(11,4)
ROW(2,10) PAINT(1,1),HUE(11,0)
ROW(1,1) STRING('█▀{16}█')
ROW(2,1) STRING('█<0{16}>█')
ROW(3,1) STRING('█▄{16}█')
ROW(2,4) STRING('Exit?')
COL(10) STRING('Y')
COL(13) STRING('Y/N')
.
DEFAULT STRING(1) !DEFAULT 'Y' OR 'N'
CODE
IF DEFAULT = 'Y'
OPEN(EXIT_SCR)
SETCURSOR(10,41)
ELSE !DEFAULT = ' ' (NO)
BEEP
OPEN(CON_SCR)
SETCURSOR(10,53)
END!IF-ELSE
LOOP !LOOP UNTIL VALID KEY IS HIT
ASK
CASE KEYCODE()
OF ENTER_KEY OROF F9_KEY
RETURN(DEFAULT)
OF ESC_KEY OROF F3_KEY |
OROF VAL('N') OROF VAL('n')
RETURN(' ')
OF VAL('Y') OROF VAL('y')
RETURN('Y')
END!CASE
BEEP !BEEP AND ASK AGAIN
END!LOOP
!╔═════════════════════════════════════════════════════════════════════════════╗
!║ PROCEDURE TO RUN A DOS COMMAND. ║
!║ THIS PROC WILL ALSO DISPLAY ANY ERROR MESSAGE ON THE MAIN SCREEN. ║
!║ THE PROC DOES NOT AUTOMATICALLY PAUSE IF THE PROGRAM ENDS WITH AN ║
!║ ERRORLEVEL SINCE MANY PROGRAMS THAT END NORMALLY RETURN AN ERROR LEVEL. ║
!║ ║
!║ PARAMETERS: ║
!║ CMD - THE COMMAND TO RUN ║
!║ RUNSMALL - RUN IN EXISTING MEMORY (Y/N) ║
!║ PAUSE - PAUSE AFTER RUNNING (Y/N) ║
!╚═════════════════════════════════════════════════════════════════════════════╝
EXEC_EXT PROCEDURE(DOS:CMD, DOS:RUNSMALL, DOS:PAUSE)
RUN_SCR SCREEN WINDOW(25,80),HUE(7,0)
OMIT('**-END-**') Rows 1 thru 1
Please Wait . . .
**-END-**
ROW(1,1) STRING('Please Wait . . .')
.
GROUP,PRE(DOS)
CMD STRING(127) !THE COMMAND TO RUN
RUNSMALL STRING(1) !RUN IN EXISTING MEMORY (Y/N)
PAUSE STRING(1) !DISPLAY 'Press any key' BEFORE RETURNING
END!GROUP
CODE
OPEN(RUN_SCR) !DISPLAY 'Please Wait ... '
IF DOS:RUNSMALL = 'N' !DOWNLOAD MEMORY IMAGE, THEN RUN
RUN(DOS:CMD)
ELSE !RUN IN EXISTING MEMORY
RUNSMALL(DOS:CMD)
END!IF-ELSE
IF (DOS:PAUSE = 'Y' | !IF USER REQUESTED PAUSE
AND RUNCODE() <> -4) | !AND NO .TMP CREATE ERROR
OR RUNCODE() = -1 !OR UNKNOWN ERROR
SETHUE(13,0) ! BRIGHT MAGENTA ON BLACK
SHOW(25,1,'Press any key to return . . . ')
SETHUE
ASK ! PAUSE
.
CLOSE(RUN_SCR) !RESTORE MAIN SCREEN
SCR:MEM_LEFT = MEMORY(0) !REDISPLAY MEMORY LEFT
!─────────────────────────────────────────────────────────────────────────────
! DISPLAY ANY ERROR MESSAGE AFTER RETURNING TO THE MAIN SCREEN.
! NOTE THAT -2 IS NOT AN ERROR. -2 IS RETURNED FOR INTERNAL DOS COMMANDS
! WHICH DO NOT RETURN EXIT CODES.
!─────────────────────────────────────────────────────────────────────────────
IF RUNCODE() = -1
SCR:MESSAGE = CENTER('COMMAND NOT EXECUTED',50)
ELSIF RUNCODE() = -3
SCR:MESSAGE = CENTER('COULDN''T FIND COMMAND.COM',50)
BEEP
ELSIF RUNCODE() = -4
SCR:MESSAGE = CENTER('COULDN''T CREATE .TMP MEMORY IMAGE FILE',50)
BEEP
ELSIF RUNCODE() > 0
SCR:MESSAGE = CENTER('PROGRAM ENDED WITH EXIT CODE OF ' & RUNCODE(),50)
END!IF-ELSE
RETURN
!╔═════════════════════════════════════════════════════════════════════════════╗
!║ FUNCTION TO VERIFY THE EXISTENCE OF THE GIF FILE. IF THE FILE IS NOT FOUND, ║
!║ IT MAY BRING UP A SCROLLING LIST OF THE FILES IN THE DIRECTORY. ║
!║ ║
!║ RETURN CODE: ║
!║ 0 - FILE WAS SELECTED, RETURNED IN RETURNFILE GLOBAL VARIABLE ║
!║ 1 - NO FILE SELECTED - USER ESCAPED OFF OF SCROLLING TABLE ║
!║ 2 - NO FILES IN DIRECTORY ║
!║ 3 - INVALID DIRECTORY ║
!╚═════════════════════════════════════════════════════════════════════════════╝
VERIFILE FUNCTION
!───────────────────────────────────────────────────────────────────────────────
! WINDOW FOR SCROLLING TABLE OF FILENAMES.
!───────────────────────────────────────────────────────────────────────────────
FILE_SCR SCREEN WINDOW(25,26),AT(1,53),PRE(SCT),HUE(12,1)
OMIT('**-END-**')
█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█
█ SELECT FILE █
█────────────────────────█
█ ■■■■■■■■■■■■■■■ █
█ ■■■■■■■■ ■■■ █
█ █
█ █
█ █
█ █
█ █
█ █
█ █
█ █
█ █
█ █
█ █
█ █
█ █
█ █
█ █
█ █
█ █
█────────────────────────█
█ Enter-View F3-Cancel █
█▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄█
**-END-**
ROW(2,2) PAINT(1,24),HUE(11,1)
ROW(24,2) PAINT(1,24),HUE(11,1)
ROW(5,8) PAINT(18,12),HUE(15,1)
ROW(1,1) STRING('█▀{24}█')
ROW(2,1) REPEAT(2),EVERY(22);STRING('█<0{24}>█') .
ROW(3,1) REPEAT(2),EVERY(20);STRING('█─{24}█') .
ROW(4,1) REPEAT(19);STRING('█<0{24}>█') .
ROW(25,1) STRING('█▄{24}█')
ROW(2,8) STRING('SELECT FILE')
ROW(24,4) STRING('Enter-View F3-Cancel')
FILESPEC ROW(4,6) STRING(15),HUE(7,1)
REPEAT(18),INDEX(TABNDX)
ROW(5,7) POINT(1,14),USE(?IPOINT),SEL(1,7)
NAME COL(8) STRING(8)
EXT COL(17) STRING(3)
. .
!───────────────────────────────────────────────────────────────────────────────
! MEMORY TABLE AND LOCAL VARIABLES.
!───────────────────────────────────────────────────────────────────────────────
DIR_TABLE TABLE,PRE(TAB) !TABLE OF FILENAMES
NAME STRING(8) ! NAME
EXT STRING(3) ! EXTENSION
END!TABLE
FULLGIFNAME STRING(128) !GIF FILENAME INCLUDING DRIVE:\PATH\
! ALSO, THE FILE SPEC USED FOR DIR GET
FPATH STRING(116) !DRIVE:\PATH ONLY OF FULLGIFNAME
FOUND BYTE !1 IF GIF FILE FOUND
WILDCARD BYTE !1 IF GIF FILENAME CONTAINS '*' OR '?'
TABTOT SHORT !TOTAL FILES IN MEMORY TABLE
TABPOINTER SHORT !LAST FILE READ FROM MEMORY TABLE
TABNDX BYTE !REPEAT INDEX FOR SCROLLING TABLE
NUM_DISP BYTE !NO. OF RECORDS ON SCROLLING TABLE
!─────────────────────────────────────────────────────────────────────────────
! CODE.
!─────────────────────────────────────────────────────────────────────────────
CODE
FULLGIFNAME = FILFULLNAME(GIFNAME) !GET COMPLETE FILENAME WITH DRIVE:\PATH
FOUND = FILEXISTS(FULLGIFNAME) !DOES FILE EXIST?
IF ERRORCODE() = 3 AND GIFNAME !IF BAD PATH (IF BLANK DEFAULT TO *.GIF)
RETURN(3) ! RETURN ERROR CODE
END!IF
IF INSTRING('*',GIFNAME,1) | !DOES FILE CONTAIN A WILDCARD?
OR INSTRING('?',GIFNAME,1)
WILDCARD = 1
ELSE
WILDCARD = 0
END!IF-ELSE
IF FOUND AND NOT WILDCARD !IF SINGLE FILE WAS FOUND
RETURNFILE = GIFNAME ! DON'T DISPLAY FULL NAME
RETURN(0) ! RETURN
ELSIF NOT FOUND AND WILDCARD !IF WILDCARD BUT NO FILES MATCHING SPEC
RETURN(2) ! NO FILES IN GIVEN DIRECTORY
END!IF-ELSE
FPATH = FILDRIVE(FULLGIFNAME) & FILDIRECTORY(FULLGIFNAME)
IF NOT FOUND AND NOT WILDCARD !IF FILE NOT FOUND AND NO WILDCARD
FULLGIFNAME = CLIP(FPATH) & '*.GIF' !DISPLAY ALL GIF FILES IN DIRECTORY
! ELSEIF FOUND AND WILDCARD !IF WILDCARD
! DO DIRECTORY ! DEFAULT TO USER'S WILDCARD SPECS
END!IF-ELSE
DO DIRECTORY !DISPLAY SCROLLING TABLE OF FILES
!───────────────────────────────────────────────────────────────────────────────
! DISPLAY SCROLLING LIST OF FILES. RETURN FULL NAME IF USER CHOOSES ONE OR
! RETURN ERROR CODE OF 1 IF USER ABORTS.
!───────────────────────────────────────────────────────────────────────────────
DIRECTORY ROUTINE
!─────────────────────────────────────────────────────────────────────────────
! READ FILENAMES INTO MEMORY TABLE AND SORT.
!─────────────────────────────────────────────────────────────────────────────
DIRGROUP = DIRGETFIRST(FULLGIFNAME,6)!GET FIRST FILE IN DIRECTORY
LOOP UNTIL ERRORCODE() !READ THE REST OF THEM
TAB:NAME = AKANAME ! NAME
TAB:EXT = AKAEXT ! EXTENSION
ADD(DIR_TABLE) ! ADD TO MEMORY TABLE
DIRGROUP = DIRGETNEXT() ! READ ANOTHER DIRECTORY ENTRY
END!LOOP
SORT(DIR_TABLE,TAB:NAME) !SORT TABLE FIRST BY NAME
SORT(DIR_TABLE,TAB:EXT) !THEN BY EXTENSION
TABTOT = RECORDS(DIR_TABLE) !COUNT TOTAL RECORDS
SHOW(2,12,MEMORY(0),@N7) !REDISPLAY MEMORY AFTER TABLE IS FILLED
IF NOT TABTOT !IF NO FILES FOR SOME REASON
FREE(DIR_TABLE) ! FREE MEMORY TABLE
RETURN(2) ! RETURN ERROR CODE
END!IF
!─────────────────────────────────────────────────────────────────────────────
! DISPLAY TABLE.
!─────────────────────────────────────────────────────────────────────────────
ALERT
ALERT(ESC_KEY)
ALERT(F3_KEY)
OPEN(FILE_SCR) !OPEN WINDOW
SCT:FILESPEC = CENTER('..\'&CLIP(FILNAME(FULLGIFNAME))&CLIP(FILEXTENSION(FULLGIFNAME)),15)
TABPOINTER = 0 !SET TO FIRST ONE
DO SHOWTAB !SHOW ONE SCREENFUL
TABNDX = 1 !HIGHLIGHT FIRST ENTRY
!─────────────────────────────────────────────────────────────────────────────
! MAIN SCREEN LOOP.
!─────────────────────────────────────────────────────────────────────────────
LOOP
ACCEPT
K = KEYCODE()
IF K = F3_KEY |
OR K = ESC_KEY
FREE(DIR_TABLE) !CLEAR MEMORY TABLE
CLOSE(FILE_SCR) !CLOSE WINDOW
RETURN(1) !TELL CALLER NO SELECTION MADE
END!IF
CASE FIELD()
OF ?IPOINT
!─────────────────────────────────────────────────────────────────────────
! PROCESS ACTION KEYS.
!─────────────────────────────────────────────────────────────────────────
CASE K
OF ENTER_KEY !ENTER: RETURN SELECTION
RETURNFILE = CLIP(FPATH) & CLIP(SCT:NAME) & '.' & SCT:EXT
FREE(DIR_TABLE) ! CLEAR MEMORY TABLE
CLOSE(FILE_SCR) ! CLOSE WINDOW
RETURN(0) ! TELL CALLER SELECTION MADE
OF UP_KEY !UP ARROW
IF TABPOINTER - NUM_DISP <= 0 ! IF ALREADY ON FIRST ONE
SELECT(?) ! STAY HERE
ELSE
GET(DIR_TABLE, TABPOINTER - NUM_DISP)
SCROLL(5,59,18,14,-1)
SCT:NAME = TAB:NAME
SCT:EXT = TAB:EXT
IF NUM_DISP < 18 ! IF LESS THAN A FULL SCREEN
NUM_DISP += 1 ! INCREMENT TOTAL DISPLAYED
ELSE ! ELSE
TABPOINTER -= 1 ! RESET POINTER TO LAST ONE ON SCREEN
END!IF-ELSE
END!IF-ELSE
OF DOWN_KEY !DOWN ARROW
IF TABPOINTER >= TABTOT ! IF ALREADY ON LAST ONE
SELECT(?) ! STAY HERE
ELSE ! ELSE
TABPOINTER += 1 ! RESET POINTER TO LAST ONE ON SCREEN
GET(DIR_TABLE, TABPOINTER)
SCROLL(5,59,18,14,1)
SCT:NAME = TAB:NAME
SCT:EXT = TAB:EXT
END!IF-ELSE
OF PGUP_KEY !PAGE UP
IF TABPOINTER <= 18 ! IF ALREADY ON FIRST ONE
SELECT(?) ! STAY HERE
ELSE
TABPOINTER -= (NUM_DISP + 18)
IF TABPOINTER < 0
TABPOINTER = 0
END!IF
DO SHOWTAB
END!IF-ELSE
TABNDX = 1 ! HIGHLIGHT FIRST ONE ON SCREEN
OF PGDN_KEY !PAGE DOWN
IF TABPOINTER >= TABTOT ! IF ALREADY ON LAST ONE
SELECT(?) ! STAY HERE
TABNDX = NUM_DISP ! HIGHLIGHT LAST ONE ON SCREEN
ELSE ! ELSE
DO SHOWTAB ! DISPLAY NEXT PAGE
TABNDX = 1 ! HIGHLIGHT FIRST ONE ON SCREEN
END!IF-ELSE
OF CTRL_PGUP !CONTROL/PAGE UP
TABPOINTER = 0
DO SHOWTAB
TABNDX = 1
OF CTRL_PGDN !CONTROL/PAGE DOWN
TABPOINTER = TABTOT - 18
IF TABPOINTER < 0
TABPOINTER = 0
END!IF
DO SHOWTAB
TABNDX = NUM_DISP
END!CASE KEYCODE()
END!CASE FIELD()
END!SCREEN LOOP
!───────────────────────────────────────────────────────────────────────────────
! DISPLAY (REDISPLAY) ONE SCREENFUL.
! TABPOINTER MUST FIRST POINT TO THE ONE PREVIOUS TO THE ONE TO DISPLAY FIRST.
! AFTERWARDS, TABPOINTER WILL POINT TO THE LAST ONE ON THE SCREEN.
!───────────────────────────────────────────────────────────────────────────────
SHOWTAB ROUTINE
LOOP TABNDX = 1 TO 18 !DISPLAY MAX OF 18 FILES
IF TABPOINTER >= TABTOT !BUT IF LAST ONE ALREADY READ
BREAK ! BREAK OUT OF LOOP
END!IF
TABPOINTER += 1
GET(DIR_TABLE,TABPOINTER)
SCT:NAME = TAB:NAME
SCT:EXT = TAB:EXT
END!LOOP
NUM_DISP = TABNDX - 1 !TOTAL ON SCROLLING TABLE
LOOP TABNDX = NUM_DISP + 1 TO 18 !IF SCROLLING TABLE IS NOT FULL
CLEAR(SCT:NAME) ! CLEAR REMAINING ENTRIES
CLEAR(SCT:EXT)
END!LOOP
EXIT