The Unsorted BBS Collection

home *** CD-ROM | disk | FTP | other *** search

/ The Unsorted BBS Collection / thegreatunsorted.tar / thegreatunsorted / programming / misc_programming / AGUL / WINDOWZ.ADB / WINDOWZ.ADB

Wrap

Text File | 1991-06-09 | 38.5 KB | 1,037 lines

-- ╔═════════════════════════════════════════════════════════════╗ -- ║█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█║ -- ║█ █║ -- ║█ Meridian Software Systems █║ -- ║█ █║ -- ║█ Copyright (C) 1990 █║ -- ║█ █║ -- ║█ ALL RIGHTS RESERVED █║ -- ║█ █║ -- ║█▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄█║ -- ╚═════════════════════════════════════════════════════════════╝ ------------------------------------------------------------------------------ -- -- Unit Name: Window - package body -- -- Purpose of unit: This package is called to define window and world -- coordinate values. This packge also sets window and -- world coordinates global with the select routines. -- The windows can be drawn on the screen. Windows can -- saved and loaded to and from a disk file. The defined -- window and world records can also be deleted with the -- reset procedures. -- ------------------------------------------------------------------------------ with SYSTEM, COMMON_DISPLAY_TYPES, DRAW, INTERRUPT, PORT; with SPY, WINDOW_IO, VIDEO, UNCHECKED_DEALLOCATION; with ADA_IO, BIT_OPS, COMMON_GRAPHIC_TYPES; use ADA_IO, BIT_OPS, COMMON_GRAPHIC_TYPES; package body WINDOW is type LIST_RECORD; type LIST_PTR is access LIST_RECORD; type LIST_RECORD is record REC_INDEX : INDEX_NUMBER := 0; UPRLFTX, UPRLFTY, LWRRGHTX, LWRRGHTY : integer; NEXT : LIST_PTR := null; end record; procedure DISPOSE is new UNCHECKED_DEALLOCATION(LIST_RECORD, LIST_PTR); WDW_LIST, WLD_LIST : LIST_PTR := null; WDW_REC, WLD_REC : LIST_RECORD; -- ===================================================================== -- -- FIND_RECORD_IN_LIST is called to find either the window or world -- record by the index number in the linked list. The pointer to the -- record will be returned if the record has been found. The boolean -- Found will return TRUE if pointer has a valid address (record was -- found) or FALSE if the record was not found. -- -- ===================================================================== procedure FIND_RECORD_IN_LIST (INDEX : in INDEX_NUMBER; TEMP_PTR : in out LIST_PTR; TEMP_REC : out LIST_RECORD; FOUND : out boolean) is PREVIOUS_PTR, CURRENT_PTR : LIST_PTR := TEMP_PTR; IN_LIST : boolean := false; begin -- FIND_RECORD_IN_LIST FOUND := IN_LIST; while CURRENT_PTR /= null and not IN_LIST loop if CURRENT_PTR.REC_INDEX < INDEX then PREVIOUS_PTR := CURRENT_PTR; CURRENT_PTR := CURRENT_PTR.NEXT; elsif CURRENT_PTR.REC_INDEX = INDEX then FOUND := true; TEMP_REC := CURRENT_PTR.all; return; else Put_line(" Window has not been defined."); return; end if; end loop; end FIND_RECORD_IN_LIST; -- ====================================================================== -- -- DELETE_LIST is called to delete all the existing records either the -- WINDOW_LIST, or the WORLD_LIST. A pointer to the record is passed -- to the procedure. -- -- ====================================================================== procedure DELETE_LIST (LIST : in out LIST_PTR) is TMP_PTR : LIST_PTR := LIST; begin while LIST /= null loop LIST := LIST.NEXT; DISPOSE(TMP_PTR); end loop; end DELETE_LIST; -- ======================================================================= -- -- ADD_RECORD_TO_LIST will insert a new record into the linked list for -- either the WINDOW_LIST or the WORLD_LIST. This procedure will insert -- the record in sequential order by INDEX_NUMBER. If the record already -- exists, it will be modified to reflect the new data. -- -- ======================================================================= procedure ADD_RECORD_TO_LIST (TMP_RECORD : in out LIST_RECORD; TMP_PTR : in out LIST_PTR; INDEX : in INDEX_NUMBER) is PREVIOUS_PTR, CURRENT_PTR : LIST_PTR := TMP_PTR; FOUND : boolean; begin if TMP_PTR /= null then while CURRENT_PTR /= null loop if CURRENT_PTR.REC_INDEX < INDEX then PREVIOUS_PTR := CURRENT_PTR; CURRENT_PTR := CURRENT_PTR.NEXT; elsif CURRENT_PTR.REC_INDEX = INDEX then TMP_RECORD.NEXT := CURRENT_PTR.NEXT; CURRENT_PTR.all := TMP_RECORD; return; else if CURRENT_PTR = TMP_PTR then TMP_RECORD.NEXT := CURRENT_PTR; TMP_PTR := new LIST_RECORD; TMP_PTR.all := TMP_RECORD; else TMP_RECORD.NEXT := CURRENT_PTR; PREVIOUS_PTR.NEXT := new LIST_RECORD; PREVIOUS_PTR.NEXT.all := TMP_RECORD; end if; return; end if; end loop; TMP_RECORD.NEXT := null; PREVIOUS_PTR.NEXT := new LIST_RECORD; PREVIOUS_PTR.NEXT.all := TMP_RECORD; else TMP_PTR := new LIST_RECORD; TMP_PTR.all := TMP_RECORD; end if; end ADD_RECORD_TO_LIST; -- ========================================================================== -- -- DEFINE_WINDOW -- -- ========================================================================== procedure DEFINE_WINDOW (WINDOW_INDEX : in INDEX_NUMBER; WDWUPX, WDWUPY, WDWLWRX, WDWLWRY : in integer) is UPRX, UPRY,LWRX,LWRY : integer; begin if WINDOW_INDEX >= 1 and WINDOW_INDEX <= 8 then UPRX := WDWUPX * CHARACTER_PIXEL_WIDTH; UPRY := WDWUPY * CHARACTER_PIXEL_HEIGHT; LWRX := (WDWLWRX * CHARACTER_PIXEL_WIDTH) + (CHARACTER_PIXEL_WIDTH - 1); LWRY := (WDWLWRY * CHARACTER_PIXEL_HEIGHT) + (CHARACTER_PIXEL_HEIGHT - 1); if (UPRX >= SCREEN_DIMENSION_UPPER_LEFT_X) and (UPRX <= SCREEN_DIMENSION_LOWER_RIGHT_X) then if (UPRY >= SCREEN_DIMENSION_UPPER_LEFT_Y) and (UPRY <= SCREEN_DIMENSION_LOWER_RIGHT_Y) then if (LWRX > UPRX) and (LWRX <= SCREEN_DIMENSION_LOWER_RIGHT_X) then if (LWRY > UPRY) and (LWRY <= SCREEN_DIMENSION_LOWER_RIGHT_Y) then WDW_REC.REC_INDEX := WINDOW_INDEX; WDW_REC.UPRLFTX := WDWUPX; WDW_REC.UPRLFTY := WDWUPY; WDW_REC.LWRRGHTX := WDWLWRX; WDW_REC.LWRRGHTY := WDWLWRY; ADD_RECORD_TO_LIST(WDW_REC,WDW_LIST,WINDOW_INDEX); else Put_line("Lower Right Y coordinate incorrect."); end if; else Put_line("Lower Right X coordinate incorrect."); end if; else Put_line("Upper Left Y coordinate incorrect."); end if; else Put_line("Upper Left X coordinate incorrect."); end if; else Put_line(" Window index out of bound, index should be between 1 and 8."); end if; end DEFINE_WINDOW; -- ========================================================================== -- -- SELECT_WINDOW -- -- ========================================================================== procedure SELECT_WINDOW (WINDOW_INDEX : in INDEX_NUMBER; BORDER_COLOR, WINDOW_FORE_COLOR, WINDOW_BACK_COLOR : in COMMON_DISPLAY_TYPES.COLOR; ENABLE_CLIP : in boolean ) is TMP_REC : LIST_RECORD; TMP_PTR : LIST_PTR := WDW_LIST; FOUND : boolean; REG_FILE : INTERRUPT.REGISTERS; COLOR_NUMBER : integer; begin FIND_RECORD_IN_LIST(WINDOW_INDEX,TMP_PTR,TMP_REC,FOUND); if FOUND then CURRENT_WINDOW_INDEX_NO := WINDOW_INDEX; CURRENT_WINDOW_UPPER_LEFT_X := TMP_REC.UPRLFTX * CHARACTER_PIXEL_WIDTH; CURRENT_WINDOW_UPPER_LEFT_Y := TMP_REC.UPRLFTY * CHARACTER_PIXEL_HEIGHT; CURRENT_WINDOW_LOWER_RIGHT_X := TMP_REC.LWRRGHTX * CHARACTER_PIXEL_WIDTH + (CHARACTER_PIXEL_WIDTH - 1); CURRENT_WINDOW_LOWER_RIGHT_Y := TMP_REC.LWRRGHTY * CHARACTER_PIXEL_HEIGHT + (CHARACTER_PIXEL_HEIGHT - 1); DRAW.FOREGROUND_COLOR(BORDER_COLOR); COMMON_GRAPHIC_TYPES.WINDOW_FORE_COLOR := WINDOW_FORE_COLOR; COMMON_GRAPHIC_TYPES.WINDOW_BACK_COLOR := WINDOW_BACK_COLOR; REG_FILE.AX := 16#0600#; COLOR_NUMBER := COMMON_DISPLAY_TYPES.COLOR'pos(WINDOW_BACK_COLOR); REG_FILE.BX := SHL(COLOR_NUMBER,8); REG_FILE.CX := SHL(TMP_REC.UPRLFTY,8); REG_FILE.CX := REG_FILE.CX or TMP_REC.UPRLFTX ; REG_FILE.DX := SHL(TMP_REC.LWRRGHTY,8); REG_FILE.DX := REG_FILE.DX or TMP_REC.LWRRGHTX ; INTERRUPT.VECTOR(16#10#,REG_FILE); DRAW.RECTANGLE(CURRENT_WINDOW_UPPER_LEFT_X, CURRENT_WINDOW_UPPER_LEFT_Y, CURRENT_WINDOW_LOWER_RIGHT_X, CURRENT_WINDOW_LOWER_RIGHT_Y); DRAW.FOREGROUND_COLOR(WINDOW_FORE_COLOR); CLIP_ENABLE := ENABLE_CLIP; else Put_line("Window has not been defined."); end if; end SELECT_WINDOW; -- ========================================================================== -- -- SAVE_WINDOW -- -- ========================================================================== procedure SAVE_WINDOW(WINDOW_INDEX : in INDEX_NUMBER; FILENAME : in string) is MASK : constant COMMON_DISPLAY_TYPES.byte := 16#FF#; BYTE_SIZE : constant integer := 8; ODD_ROW_MEMORY_OFFSET : constant long_integer := 16#2000#; SEGMENT_MULTIPLIER : constant long_integer := 16#1000#; RIGHT_TMP_MASK, LEFT_TMP_MASK : COMMON_DISPLAY_TYPES.byte := MASK; READ_BYTE : SPY.byte; FOUND : boolean; TMP_REC : LIST_RECORD; TMP_PTR : LIST_PTR := WDW_LIST; READ_WRITE_OFFSET, INDEX : integer := 0; WINDOW_UPPER_LEFT_X, WINDOW_LOWER_RIGHT_X : COMMON_GRAPHIC_TYPES.HORIZONTAL; WINDOW_UPPER_LEFT_Y, WINDOW_LOWER_RIGHT_Y : COMMON_GRAPHIC_TYPES.VERTICAL; LEFT_BYTE_OFFSET, RIGHT_BYTE_OFFSET : COMMON_DISPLAY_TYPES.byte; EVEN_ROW_ADDRESS, EVEN_ROW_START_ADDRESS, ODD_ROW_ADDRESS, ODD_ROW_START_ADDRESS, START_ADDRESS, SYSTEM_ADDRESS, TMP_ADDRESS : long_integer; TMP_MASK, NUMBER_OF_BYTES, BITS_PER_PIXEL, BYTES_PER_ROW, WINDOW_LEFT_OFFSET, WINDOW_RIGHT_OFFSET : integer; BYTE_RECORD : WINDOW_IO.BYTE_REC ; -- =========================================================================== -- -- Check to see if Window has been defined -- -- =========================================================================== begin -- Save_Window FIND_RECORD_IN_LIST(WINDOW_INDEX,TMP_PTR,TMP_REC,FOUND); if FOUND then if not WINDOW_IO.Create(FILE_NAME => FILENAME) then return; end if; -- =========================================================================== -- -- Convert to pixel values -- -- =========================================================================== WINDOW_UPPER_LEFT_X := TMP_REC.UPRLFTX * CHARACTER_PIXEL_WIDTH; WINDOW_UPPER_LEFT_Y := TMP_REC.UPRLFTY * CHARACTER_PIXEL_HEIGHT; WINDOW_LOWER_RIGHT_X := TMP_REC.LWRRGHTX * CHARACTER_PIXEL_WIDTH + (CHARACTER_PIXEL_WIDTH - 1); WINDOW_LOWER_RIGHT_Y := TMP_REC.LWRRGHTY * CHARACTER_PIXEL_HEIGHT + (CHARACTER_PIXEL_HEIGHT - 1); -- =========================================================================== -- -- Check for graphics type to determine bits_per_pixel. 2 bits required -- for CGA 4 color mode, all other modes have 1 bit per pixel. The -- graphics mode will also determine how many bytes there are per row. -- If 350 x 200 there is 40 bytes per row otherwise, there are 80 bytes -- to a row. An additional offset is reqired for EGA to read all the -- rows. -- -- =========================================================================== case GRAPH_SCREEN is when 4 | 5 => BYTES_PER_ROW := 80; BITS_PER_PIXEL := 2; when 6 => BYTES_PER_ROW := 80; BITS_PER_PIXEL := 1; when 14 => BYTES_PER_ROW := 40; READ_WRITE_OFFSET := 20; BITS_PER_PIXEL := 1; when 15 => BYTES_PER_ROW := 80; READ_WRITE_OFFSET := 20; BITS_PER_PIXEL := 1; when 16 | 17 => BYTES_PER_ROW := 80; READ_WRITE_OFFSET := 0; BITS_PER_PIXEL := 1; when 18 | 19 => BYTES_PER_ROW := 80; READ_WRITE_OFFSET := 48; BITS_PER_PIXEL := 1; when others => null; end case; -- =========================================================================== -- -- Determine offset into first and last byte in row. If Cga mode then -- need to adjust rows, since odd rows are in the second 8k of memory and -- even rows are in the first 8k of display memory. -- -- =========================================================================== if GRAPH_SCREEN >= 4 and GRAPH_SCREEN <= 6 then WINDOW_LEFT_OFFSET := ((BYTES_PER_ROW * WINDOW_UPPER_LEFT_Y) / 2) + ((WINDOW_UPPER_LEFT_X * BITS_PER_PIXEL) / BYTE_SIZE); else WINDOW_LEFT_OFFSET := (BYTES_PER_ROW * WINDOW_UPPER_LEFT_Y) + ((WINDOW_UPPER_LEFT_X * BITS_PER_PIXEL) / BYTE_SIZE); end if; NUMBER_OF_BYTES := ((WINDOW_LOWER_RIGHT_X - WINDOW_UPPER_LEFT_X) * BITS_PER_PIXEL) / BYTE_SIZE; SYSTEM_ADDRESS := PAGE1_MEMORY_START; LEFT_BYTE_OFFSET := (WINDOW_UPPER_LEFT_X * BITS_PER_PIXEL) mod 8; case LEFT_BYTE_OFFSET is when 7 => LEFT_TMP_MASK := 16#7F#; when 6 => LEFT_TMP_MASK := 16#3F#; when 5 => LEFT_TMP_MASK := 16#1F#; when 4 => LEFT_TMP_MASK := 16#0F#; when 3 => LEFT_TMP_MASK := 16#07#; when 2 => LEFT_TMP_MASK := 16#03#; when 1 => LEFT_TMP_MASK := 16#01#; when 0 => LEFT_TMP_MASK := 16#00#; when others => LEFT_TMP_MASK := 16#FF#; end case; RIGHT_BYTE_OFFSET := (WINDOW_LOWER_RIGHT_X * BITS_PER_PIXEL) mod 8; case RIGHT_BYTE_OFFSET is when 7 => RIGHT_TMP_MASK := 16#FE#; when 6 => RIGHT_TMP_MASK := 16#FC#; when 5 => RIGHT_TMP_MASK := 16#F8#; when 4 => RIGHT_TMP_MASK := 16#F0#; when 3 => RIGHT_TMP_MASK := 16#E0#; when 2 => RIGHT_TMP_MASK := 16#C0#; when 1 => RIGHT_TMP_MASK := 16#80#; when 0 => RIGHT_TMP_MASK := 16#00#; when others => RIGHT_TMP_MASK := 16#FF#; end case; -- ========================================================================== -- -- CGA MODE -- -- ========================================================================== if GRAPH_SCREEN >= 4 and GRAPH_SCREEN <= 6 then if WINDOW_UPPER_LEFT_Y mod 2 = 0 then EVEN_ROW_START_ADDRESS := SYSTEM_ADDRESS + long_integer(WINDOW_LEFT_OFFSET); ODD_ROW_START_ADDRESS := SYSTEM_ADDRESS + ODD_ROW_MEMORY_OFFSET + long_integer(WINDOW_LEFT_OFFSET); else ODD_ROW_START_ADDRESS := SYSTEM_ADDRESS + ODD_ROW_MEMORY_OFFSET + long_integer(WINDOW_LEFT_OFFSET); EVEN_ROW_START_ADDRESS := ((long_integer(WINDOW_UPPER_LEFT_Y) + long_integer(1) / long_integer(2)) * long_integer(BYTES_PER_ROW) + long_integer(WINDOW_LEFT_OFFSET)) + SYSTEM_ADDRESS; end if; for ROW_NUMBER in WINDOW_UPPER_LEFT_Y..WINDOW_LOWER_RIGHT_Y loop ODD_ROW_ADDRESS := ODD_ROW_START_ADDRESS; EVEN_ROW_ADDRESS := EVEN_ROW_START_ADDRESS; if ROW_NUMBER mod 2 = 0 then if LEFT_BYTE_OFFSET > 0 then INDEX := INDEX + 1; READ_BYTE := SPY.PEEK(SYSTEM.ADDRESS(EVEN_ROW_ADDRESS)); READ_BYTE := READ_BYTE and LEFT_TMP_MASK; BYTE_RECORD.BYTE_ARRAY(INDEX) := READ_BYTE; EVEN_ROW_ADDRESS := EVEN_ROW_ADDRESS + long_integer(1); end if; for COUNT in 1 .. NUMBER_OF_BYTES loop INDEX := INDEX + 1; BYTE_RECORD.BYTE_ARRAY(INDEX) := SPY.PEEK(SYSTEM.ADDRESS(EVEN_ROW_ADDRESS)); EVEN_ROW_ADDRESS := EVEN_ROW_ADDRESS + long_integer(1); end loop; if RIGHT_BYTE_OFFSET >0 then BYTE_RECORD.BYTE_ARRAY(INDEX + 1) := SPY.PEEK(SYSTEM.ADDRESS(EVEN_ROW_ADDRESS)) and RIGHT_TMP_MASK; end if; EVEN_ROW_START_ADDRESS := EVEN_ROW_START_ADDRESS + long_integer(BYTES_PER_ROW); else if LEFT_BYTE_OFFSET > 0 then INDEX := INDEX + 1; READ_BYTE := SPY.PEEK(SYSTEM.ADDRESS(ODD_ROW_ADDRESS)); BYTE_RECORD.BYTE_ARRAY(INDEX) := READ_BYTE and LEFT_TMP_MASK; ODD_ROW_ADDRESS := ODD_ROW_ADDRESS + long_integer(1); end if; for COUNT in 1 .. NUMBER_OF_BYTES loop INDEX := INDEX + 1; BYTE_RECORD.BYTE_ARRAY(INDEX) := SPY.PEEK(SYSTEM.ADDRESS(ODD_ROW_ADDRESS)); ODD_ROW_ADDRESS := ODD_ROW_ADDRESS + long_integer(1); end loop; if RIGHT_BYTE_OFFSET > 0 then BYTE_RECORD.BYTE_ARRAY(INDEX + 1) := SPY.PEEK(SYSTEM.ADDRESS(ODD_ROW_ADDRESS)); end if; ODD_ROW_START_ADDRESS := ODD_ROW_START_ADDRESS + long_integer(BYTES_PER_ROW); end if; if not WINDOW_IO.Write(REC => BYTE_RECORD) then return; end if; INDEX := 0; end loop; -- =========================================================================== -- -- EGA MODE -- -- =========================================================================== else if ACTIVE_PAGE =0 then START_ADDRESS := PAGE1_MEMORY_START + long_integer(WINDOW_LEFT_OFFSET); else START_ADDRESS := PAGE2_MEMORY_START + long_integer(WINDOW_LEFT_OFFSET); end if; for ROW_COUNT in WINDOW_UPPER_LEFT_Y .. WINDOW_LOWER_RIGHT_Y + READ_WRITE_OFFSET loop TMP_ADDRESS := START_ADDRESS; INDEX := 0; if LEFT_BYTE_OFFSET > 0 then INDEX := INDEX + 1; PORT.OUT_WORD(16#03CE#,16#0004#); BYTE_RECORD.BYTE_ARRAY(INDEX) := SPY.PEEK(SYSTEM.ADDRESS(TMP_ADDRESS)); INDEX := INDEX + 1; PORT.OUT_WORD(16#03CE#,16#0104#); BYTE_RECORD.BYTE_ARRAY(INDEX) := SPY.PEEK(SYSTEM.ADDRESS(TMP_ADDRESS)) ; INDEX := INDEX + 1; PORT.OUT_WORD(16#03CE#,16#0204#); BYTE_RECORD.BYTE_ARRAY(INDEX) := SPY.PEEK(SYSTEM.ADDRESS(TMP_ADDRESS)) ; INDEX := INDEX + 1; PORT.OUT_WORD(16#03CE#,16#0304#); BYTE_RECORD.BYTE_ARRAY(INDEX) := SPY.PEEK(SYSTEM.ADDRESS(TMP_ADDRESS)) ; TMP_ADDRESS := TMP_ADDRESS + long_integer(1); end if; for COUNT in 1..NUMBER_OF_BYTES loop INDEX := INDEX + 1; PORT.OUT_WORD(16#03CE#,16#0004#); BYTE_RECORD.BYTE_ARRAY(INDEX) := SPY.PEEK(SYSTEM.ADDRESS(TMP_ADDRESS)) ; INDEX := INDEX + 1; PORT.OUT_WORD(16#03CE#,16#0104#); BYTE_RECORD.BYTE_ARRAY(INDEX) := SPY.PEEK(SYSTEM.ADDRESS(TMP_ADDRESS)) ; INDEX := INDEX + 1; PORT.OUT_WORD(16#03CE#,16#0204#); BYTE_RECORD.BYTE_ARRAY(INDEX) := SPY.PEEK(SYSTEM.ADDRESS(TMP_ADDRESS)) ; INDEX := INDEX + 1; PORT.OUT_WORD(16#03CE#,16#0304#); BYTE_RECORD.BYTE_ARRAY(INDEX) := SPY.PEEK(SYSTEM.ADDRESS(TMP_ADDRESS)); TMP_ADDRESS := TMP_ADDRESS + long_integer(1); end loop; if RIGHT_BYTE_OFFSET > 0 then INDEX := INDEX + 1; PORT.OUT_WORD(16#03CE#,16#0004#); BYTE_RECORD.BYTE_ARRAY(INDEX) := SPY.PEEK(SYSTEM.ADDRESS(TMP_ADDRESS)); INDEX := INDEX + 1; PORT.OUT_WORD(16#03CE#,16#0104#); BYTE_RECORD.BYTE_ARRAY(INDEX) := SPY.PEEK(SYSTEM.ADDRESS(TMP_ADDRESS)); INDEX := INDEX + 1; PORT.OUT_WORD(16#03CE#,16#0204#); BYTE_RECORD.BYTE_ARRAY(INDEX) := SPY.PEEK(SYSTEM.ADDRESS(TMP_ADDRESS)); INDEX := INDEX + 1; PORT.OUT_WORD(16#03CE#,16#0304#); BYTE_RECORD.BYTE_ARRAY(INDEX) := SPY.PEEK(SYSTEM.ADDRESS(TMP_ADDRESS)); end if; if not WINDOW_IO.Write(REC => BYTE_RECORD) then return; end if; START_ADDRESS := START_ADDRESS + long_integer(BYTES_PER_ROW); end loop; end if; if not WINDOW_IO.Close then return; end if; else Put_line("Window hasn't been defined"); end if; end SAVE_WINDOW; -- ========================================================================== -- -- LOAD_WINDOW -- -- ========================================================================== procedure LOAD_WINDOW(WINDOW_INDEX : in INDEX_NUMBER; FILENAME : in string; NEWX, NEWY : in integer) is GOOD, FOUND : boolean; MASK : constant COMMON_DISPLAY_TYPES.byte := 16#FF#; BYTE_SIZE : constant := 8; ODD_ROW_MEMORY_OFFSET : constant long_integer := 16#2000#; SEGMENT_MULTIPLIER : constant long_integer := 16#1000#; RIGHT_TMP_MASK, LEFT_TMP_MASK : COMMON_DISPLAY_TYPES.byte := MASK; READ_BYTE : SPY.byte; TMP_REC : LIST_RECORD; TMP_PTR : LIST_PTR := WDW_LIST; WINDOW_UPPER_LEFT_X, WINDOW_LOWER_RIGHT_X : COMMON_GRAPHIC_TYPES.HORIZONTAL; WINDOW_UPPER_LEFT_Y, WINDOW_LOWER_RIGHT_Y : COMMON_GRAPHIC_TYPES.VERTICAL; LEFT_BYTE_OFFSET, RIGHT_BYTE_OFFSET : COMMON_DISPLAY_TYPES.byte; SYSTEM_ADDRESS, START_ADDRESS, TMP_ADDRESS, EVEN_ROW_ADDRESS, ODD_ROW_ADDRESS, EVEN_ROW_START_ADDRESS, ODD_ROW_START_ADDRESS : long_integer; BYTE_RECORD : WINDOW_IO.BYTE_REC; BITS_PER_PIXEL, WINDOW_LEFT_OFFSET, WINDOW_RIGHT_OFFSET, NUMBER_OF_BYTES, BYTES_PER_ROW, NEW_RIGHT_Y, NEW_RIGHT_X, READ_WRITE_OFFSET, INDEX : integer := 0; begin --LOAD_WINDOW FIND_RECORD_IN_LIST(WINDOW_INDEX, TMP_PTR, TMP_REC, FOUND); if FOUND then if not WINDOW_IO.Open(FILE_NAME => FILENAME) then return; end if; CURRENT_WINDOW_INDEX_NO := WINDOW_INDEX; -- =========================================================================== -- -- Convert to pixel values -- -- =========================================================================== WINDOW_UPPER_LEFT_X := TMP_REC.UPRLFTX * CHARACTER_PIXEL_WIDTH; WINDOW_UPPER_LEFT_Y := TMP_REC.UPRLFTY * CHARACTER_PIXEL_HEIGHT; WINDOW_LOWER_RIGHT_X := TMP_REC.LWRRGHTX * CHARACTER_PIXEL_WIDTH + (CHARACTER_PIXEL_WIDTH - 1); WINDOW_LOWER_RIGHT_Y := TMP_REC.LWRRGHTY * CHARACTER_PIXEL_HEIGHT + (CHARACTER_PIXEL_HEIGHT - 1); -- =========================================================================== -- -- See if new coordinates are within the screen limits -- -- =========================================================================== if NEWX >= 0 and NEWX <= 79 and NEWY >= 0 and NEWY <= 54 then NEW_RIGHT_X := ((NEWX + (TMP_REC.LWRRGHTX - TMP_REC.UPRLFTX)) * CHARACTER_PIXEL_WIDTH) + CHARACTER_PIXEL_WIDTH - 1; NEW_RIGHT_Y := ((NEWY + (TMP_REC.LWRRGHTY - TMP_REC.UPRLFTY)) * CHARACTER_PIXEL_HEIGHT) + CHARACTER_PIXEL_HEIGHT - 1; if NEW_RIGHT_Y <= SCREEN_DIMENSION_LOWER_RIGHT_Y and NEW_RIGHT_X <= SCREEN_DIMENSION_LOWER_RIGHT_X then WINDOW_UPPER_LEFT_Y := NEWY * CHARACTER_PIXEL_HEIGHT; WINDOW_UPPER_LEFT_X := NEWX * CHARACTER_PIXEL_WIDTH; WINDOW_LOWER_RIGHT_Y := NEW_RIGHT_Y; WINDOW_LOWER_RIGHT_X := NEW_RIGHT_X; end if; end if; -- =========================================================================== -- -- Set global values -- -- =========================================================================== CURRENT_WINDOW_UPPER_LEFT_X := WINDOW_UPPER_LEFT_X; CURRENT_WINDOW_UPPER_LEFT_Y := WINDOW_UPPER_LEFT_Y; CURRENT_WINDOW_LOWER_RIGHT_X := WINDOW_LOWER_RIGHT_X; CURRENT_WINDOW_LOWER_RIGHT_Y := WINDOW_LOWER_RIGHT_Y; -- =========================================================================== -- -- Check for graphics type to determine bits_per_pixel. 2 bits required -- for CGA 4 color mode, all other modes have 1 bit per pixel. The -- graphics mode will also determine how many bytes there are per row. -- If 350 x 200 there is 40 bytes per row otherwise, there are 80 bytes -- to a row. An additional offset is reqired for EGA to read all the -- rows. -- -- =========================================================================== case GRAPH_SCREEN is when 4 | 5 => BYTES_PER_ROW := 80; BITS_PER_PIXEL := 2; when 6 => BYTES_PER_ROW := 80; BITS_PER_PIXEL := 1; when 14 => BYTES_PER_ROW := 40; READ_WRITE_OFFSET := 20; BITS_PER_PIXEL := 1; when 15 => BYTES_PER_ROW := 80; READ_WRITE_OFFSET := 20; BITS_PER_PIXEL := 1; when 16 | 17 => BYTES_PER_ROW := 80; READ_WRITE_OFFSET := 0; BITS_PER_PIXEL := 1; when 18 | 19 => BYTES_PER_ROW := 80; READ_WRITE_OFFSET := 48; BITS_PER_PIXEL := 1; when others => null; end case; -- =========================================================================== -- -- Determine offset into first and last byte in row. If Cga mode then -- need to adjust rows, since odd rows are in the second 8k of memory and -- even rows are in the first 8k of display memory. -- -- =========================================================================== if GRAPH_SCREEN >= 4 and GRAPH_SCREEN <= 6 then WINDOW_LEFT_OFFSET := ((WINDOW_UPPER_LEFT_Y * BYTES_PER_ROW ) / 2) + ((WINDOW_UPPER_LEFT_X * BITS_PER_PIXEL) / BYTE_SIZE); else WINDOW_LEFT_OFFSET := ( WINDOW_UPPER_LEFT_Y * BYTES_PER_ROW ) + ((WINDOW_UPPER_LEFT_X * BITS_PER_PIXEL) / BYTE_SIZE); end if; NUMBER_OF_BYTES := ((WINDOW_LOWER_RIGHT_X - WINDOW_UPPER_LEFT_X) * BITS_PER_PIXEL) / BYTE_SIZE; LEFT_BYTE_OFFSET := (WINDOW_UPPER_LEFT_X * BITS_PER_PIXEL) mod 8; case LEFT_BYTE_OFFSET is when 7 => LEFT_TMP_MASK := 16#7F#; when 6 => LEFT_TMP_MASK := 16#3F#; when 5 => LEFT_TMP_MASK := 16#1F#; when 4 => LEFT_TMP_MASK := 16#0F#; when 3 => LEFT_TMP_MASK := 16#07#; when 2 => LEFT_TMP_MASK := 16#03#; when 1 => LEFT_TMP_MASK := 16#01#; when 0 => LEFT_TMP_MASK := 16#00#; when others => LEFT_TMP_MASK := 16#FF#; end case; RIGHT_BYTE_OFFSET := (WINDOW_LOWER_RIGHT_X * BITS_PER_PIXEL) mod 8; case RIGHT_BYTE_OFFSET is when 7 => RIGHT_TMP_MASK := 16#FE#; when 6 => RIGHT_TMP_MASK := 16#FC#; when 5 => RIGHT_TMP_MASK := 16#F8#; when 4 => RIGHT_TMP_MASK := 16#F0#; when 3 => RIGHT_TMP_MASK := 16#E0#; when 2 => RIGHT_TMP_MASK := 16#C0#; when 1 => RIGHT_TMP_MASK := 16#80#; when 0 => RIGHT_TMP_MASK := 16#00#; when others => RIGHT_TMP_MASK := 16#FF#; end case; -- =========================================================================== -- -- CGA MODE -- -- =========================================================================== if GRAPH_SCREEN >= 4 and GRAPH_SCREEN <= 6 then SYSTEM_ADDRESS := PAGE1_MEMORY_START; if WINDOW_UPPER_LEFT_Y mod 2 = 0 then EVEN_ROW_START_ADDRESS := SYSTEM_ADDRESS + long_integer(WINDOW_LEFT_OFFSET); ODD_ROW_START_ADDRESS := SYSTEM_ADDRESS + ODD_ROW_MEMORY_OFFSET + long_integer(WINDOW_LEFT_OFFSET); else ODD_ROW_START_ADDRESS := SYSTEM_ADDRESS + ODD_ROW_MEMORY_OFFSET + long_integer(WINDOW_LEFT_OFFSET); EVEN_ROW_START_ADDRESS := ((long_integer(WINDOW_UPPER_LEFT_Y) + long_integer(1) / long_integer(2)) * long_integer(BYTES_PER_ROW) + long_integer(WINDOW_LEFT_OFFSET)) + SYSTEM_ADDRESS; end if; for ROW_NUMBER in WINDOW_UPPER_LEFT_Y .. WINDOW_LOWER_RIGHT_Y loop EVEN_ROW_ADDRESS := EVEN_ROW_START_ADDRESS; ODD_ROW_ADDRESS := ODD_ROW_START_ADDRESS; WINDOW_IO.Read(REC => BYTE_RECORD, OK => GOOD); if not GOOD then return; end if; if ROW_NUMBER mod 2 = 0 then if LEFT_BYTE_OFFSET > 0 then INDEX := INDEX + 1; BYTE_RECORD.BYTE_ARRAY(INDEX) := BYTE_RECORD.BYTE_ARRAY(INDEX) and LEFT_TMP_MASK; SPY.POKE(BYTE_RECORD.BYTE_ARRAY(INDEX), SYSTEM.ADDRESS(EVEN_ROW_ADDRESS)); EVEN_ROW_ADDRESS := EVEN_ROW_ADDRESS + long_integer(1); end if; for COUNT in 1 .. NUMBER_OF_BYTES loop INDEX := INDEX + 1; SPY.POKE(BYTE_RECORD.BYTE_ARRAY(INDEX), SYSTEM.ADDRESS(EVEN_ROW_ADDRESS)); EVEN_ROW_ADDRESS := EVEN_ROW_ADDRESS + long_integer(1); end loop; if RIGHT_BYTE_OFFSET > 0 then INDEX := INDEX + 1; BYTE_RECORD.BYTE_ARRAY(INDEX) := BYTE_RECORD.BYTE_ARRAY(INDEX) and RIGHT_TMP_MASK; SPY.POKE(BYTE_RECORD.BYTE_ARRAY(INDEX), SYSTEM.ADDRESS(EVEN_ROW_ADDRESS)); end if; EVEN_ROW_START_ADDRESS := EVEN_ROW_START_ADDRESS + long_integer(BYTES_PER_ROW); else if LEFT_BYTE_OFFSET > 0 then INDEX := INDEX + 1; BYTE_RECORD.BYTE_ARRAY(INDEX) := BYTE_RECORD.BYTE_ARRAY(INDEX) and LEFT_TMP_MASK; SPY.POKE(BYTE_RECORD.BYTE_ARRAY(INDEX), SYSTEM.ADDRESS(ODD_ROW_ADDRESS)); ODD_ROW_ADDRESS := ODD_ROW_ADDRESS + long_integer(1); end if; for COUNT in 1 .. NUMBER_OF_BYTES loop INDEX := INDEX + 1; SPY.POKE(BYTE_RECORD.BYTE_ARRAY(INDEX), SYSTEM.ADDRESS(ODD_ROW_ADDRESS)); ODD_ROW_ADDRESS := ODD_ROW_ADDRESS + long_integer(1); end loop; if RIGHT_BYTE_OFFSET > 0 then INDEX := INDEX + 1; BYTE_RECORD.BYTE_ARRAY(INDEX) := BYTE_RECORD.BYTE_ARRAY(INDEX) and RIGHT_TMP_MASK; SPY.POKE(BYTE_RECORD.BYTE_ARRAY(INDEX), SYSTEM.ADDRESS(ODD_ROW_ADDRESS)); end if; ODD_ROW_START_ADDRESS := ODD_ROW_START_ADDRESS + long_integer(BYTES_PER_ROW); end if; INDEX := 0; end loop; else -- =========================================================================== -- -- EGA MODE -- -- =========================================================================== if ACTIVE_PAGE =0 then START_ADDRESS := PAGE1_MEMORY_START + long_integer(WINDOW_LEFT_OFFSET); else START_ADDRESS := PAGE2_MEMORY_START + long_integer(WINDOW_LEFT_OFFSET); end if; for ROW_COUNT in WINDOW_UPPER_LEFT_Y .. WINDOW_LOWER_RIGHT_Y + READ_WRITE_OFFSET loop WINDOW_IO.Read(REC => BYTE_RECORD, OK => GOOD); if not GOOD then return; end if; INDEX := 0; TMP_ADDRESS := START_ADDRESS; if LEFT_BYTE_OFFSET > 0 then INDEX := INDEX + 1; PORT.OUT_WORD(16#03CE#,16#0008#); PORT.OUT_WORD(16#03CF#,LEFT_TMP_MASK); READ_BYTE := SPY.PEEK(SYSTEM.ADDRESS(TMP_ADDRESS)); SPY.POKE(16#00#,SYSTEM.ADDRESS(TMP_ADDRESS)); PORT.OUT_WORD(16#03C4#,16#0002#); PORT.OUT_WORD(16#03C5#,16#0001#); SPY.POKE(BYTE_RECORD.BYTE_ARRAY(INDEX), SYSTEM.ADDRESS(TMP_ADDRESS)); INDEX := INDEX + 1; PORT.OUT_WORD(16#03C5#,16#0002#); SPY.POKE(BYTE_RECORD.BYTE_ARRAY(INDEX), SYSTEM.ADDRESS(TMP_ADDRESS)); INDEX := INDEX + 1; PORT.OUT_WORD(16#03C5#,16#0004#); SPY.POKE(BYTE_RECORD.BYTE_ARRAY(INDEX), SYSTEM.ADDRESS(TMP_ADDRESS)); INDEX := INDEX + 1; PORT.OUT_WORD(16#03C5#,16#0008#); SPY.POKE(BYTE_RECORD.BYTE_ARRAY(INDEX), SYSTEM.ADDRESS(TMP_ADDRESS)); TMP_ADDRESS := TMP_ADDRESS + long_integer(1); end if; for COUNT in 1..NUMBER_OF_BYTES loop INDEX := INDEX + 1; PORT.OUT_WORD(16#3CE#,16#0008#); PORT.OUT_WORD(16#3CF#,16#00FF#); READ_BYTE := SPY.PEEK(SYSTEM.ADDRESS(TMP_ADDRESS)); SPY.POKE(16#00#,SYSTEM.ADDRESS(TMP_ADDRESS)); PORT.OUT_WORD(16#3C4#,16#0002#); PORT.OUT_WORD(16#03C5#,16#0001#); SPY.POKE(BYTE_RECORD.BYTE_ARRAY(INDEX), SYSTEM.ADDRESS(TMP_ADDRESS)); INDEX := INDEX + 1; PORT.OUT_WORD(16#03C5#,16#0002#); SPY.POKE(BYTE_RECORD.BYTE_ARRAY(INDEX), SYSTEM.ADDRESS(TMP_ADDRESS)); INDEX := INDEX + 1; PORT.OUT_WORD(16#03C5#,16#0004#); SPY.POKE(BYTE_RECORD.BYTE_ARRAY(INDEX), SYSTEM.ADDRESS(TMP_ADDRESS)); INDEX := INDEX + 1; PORT.OUT_WORD(16#03C5#,16#0008#); SPY.POKE(BYTE_RECORD.BYTE_ARRAY(INDEX), SYSTEM.ADDRESS(TMP_ADDRESS)); TMP_ADDRESS := TMP_ADDRESS + long_integer(1); end loop; if RIGHT_BYTE_OFFSET > 0 then RIGHT_TMP_MASK := SHR(RIGHT_TMP_MASK,RIGHT_BYTE_OFFSET); INDEX := INDEX + 1; PORT.OUT_WORD(16#3CE#,16#0008#); PORT.OUT_WORD(16#3CF#,16#00FF#); READ_BYTE := SPY.PEEK(SYSTEM.ADDRESS(TMP_ADDRESS)); SPY.POKE(16#00#,SYSTEM.ADDRESS(TMP_ADDRESS)); PORT.OUT_WORD(16#3C4#,16#0002#); PORT.OUT_WORD(16#03C5#,16#0001#); SPY.POKE(BYTE_RECORD.BYTE_ARRAY(INDEX), SYSTEM.ADDRESS(TMP_ADDRESS)); INDEX := INDEX + 1; PORT.OUT_WORD(16#03C5#,16#0002#); SPY.POKE(BYTE_RECORD.BYTE_ARRAY(INDEX), SYSTEM.ADDRESS(TMP_ADDRESS)); INDEX := INDEX + 1; PORT.OUT_WORD(16#03C5#,16#0004#); SPY.POKE(BYTE_RECORD.BYTE_ARRAY(INDEX), SYSTEM.ADDRESS(TMP_ADDRESS)); INDEX := INDEX + 1; PORT.OUT_WORD(16#03C5#,16#0008#); SPY.POKE(BYTE_RECORD.BYTE_ARRAY(INDEX), SYSTEM.ADDRESS(TMP_ADDRESS)); end if; START_ADDRESS := START_ADDRESS + long_integer(BYTES_PER_ROW); end loop; end if; if not WINDOW_IO.Close then return; end if; else Put_line("Window hasn't been defined"); end if; end LOAD_WINDOW; -- ========================================================================== -- -- RESET_WINDOW -- -- ========================================================================== procedure RESET_WINDOW is begin CURRENT_WINDOW_INDEX_NO := 0; CLIP_ENABLE := false; DELETE_LIST(WDW_LIST); CURRENT_WINDOW_UPPER_LEFT_X := SCREEN_DIMENSION_UPPER_LEFT_X; CURRENT_WINDOW_UPPER_LEFT_Y := SCREEN_DIMENSION_UPPER_LEFT_Y; CURRENT_WINDOW_LOWER_RIGHT_X := SCREEN_DIMENSION_LOWER_RIGHT_X; CURRENT_WINDOW_LOWER_RIGHT_Y := SCREEN_DIMENSION_LOWER_RIGHT_Y; end RESET_WINDOW; -- ========================================================================= -- -- WORLD_COORDINATES -- -- ========================================================================= procedure WORLD_COORDINATES(WORLD_INDEX : in INDEX_NUMBER; WLDLWRX, WLDLWRY : in integer) is begin if WORLD_INDEX >= 1 and WORLD_INDEX <= 8 then WLD_REC.REC_INDEX := WORLD_INDEX; WLD_REC.LWRRGHTX := WLDLWRX; WLD_REC.LWRRGHTY := WLDLWRY; ADD_RECORD_TO_LIST(WLD_REC,WLD_LIST,WORLD_INDEX); else Put_line(" World index out of bound."); end if; end WORLD_COORDINATES; -- ========================================================================= -- -- WORLD_SELECT -- -- ========================================================================= procedure WORLD_SELECT(WORLD_INDEX : in INDEX_NUMBER) is TMP_PTR : LIST_PTR := WLD_LIST; TMP_REC : LIST_RECORD; FOUND : boolean; WORLD_VALUE : integer; SCREEN_VALUE : float; begin FIND_RECORD_IN_LIST(WORLD_INDEX,TMP_PTR,TMP_REC,FOUND); if FOUND then CURRENT_WORLD_INDEX_NO := WORLD_INDEX; CURRENT_WORLD_LOWER_RIGHT_X := TMP_REC.LWRRGHTX; CURRENT_WORLD_LOWER_RIGHT_Y := TMP_REC.LWRRGHTY; WORLD_VALUE := CURRENT_WORLD_LOWER_RIGHT_X - CURRENT_WORLD_LEFT_X; SCREEN_VALUE := float(SCREEN_DIMENSION_LOWER_RIGHT_X - SCREEN_DIMENSION_UPPER_LEFT_X); SCREEN_WORLD_RATIO_X := SCREEN_VALUE / (float (WORLD_VALUE)); WORLD_VALUE := CURRENT_WORLD_LOWER_RIGHT_Y - CURRENT_WORLD_LEFT_Y; SCREEN_VALUE := float(SCREEN_DIMENSION_LOWER_RIGHT_Y - SCREEN_DIMENSION_UPPER_LEFT_Y); SCREEN_WORLD_RATIO_Y := SCREEN_VALUE / (float (WORLD_VALUE)); else Put_line("World has not been defined."); end if; end WORLD_SELECT; -- ========================================================================== -- -- WORLD_RESET -- -- ========================================================================== procedure WORLD_RESET is begin CURRENT_WORLD_INDEX_NO := 0; DELETE_LIST(WLD_LIST); CURRENT_WORLD_LOWER_RIGHT_X := SCREEN_DIMENSION_LOWER_RIGHT_X; CURRENT_WORLD_LOWER_RIGHT_Y := SCREEN_DIMENSION_LOWER_RIGHT_Y; SCREEN_WORLD_RATIO_X := 1.0; SCREEN_WORLD_RATIO_Y := 1.0; end WORLD_RESET; end WINDOW;