Inne typowe zastosowanie EPROM.
Jest to urządzenie zbudowane na bazie płyty głównej komputera PC, które do pracy potrzebuje jedynie karty grafiki zgodnej ze standardem VGA. Do budowy została użyta płyta główna od komputerów PC z procesorem Intel 80286. Być może wielu Czytelników nie widziała czegoś takiego, więc wygląda to następująco:
Zastosowany tu procesor i80286 pracujący z zawrotną prędkością, bo był taktowany z generatora dającego impulsy zegarowe o częstotliwości maksymalnie kilkunastu MHz (procesor w płycie głównej na fotografii 1 jest taktowany częstotliwością 16MHz), raczej należy uznać na mało udany.Był to pierwszy model w rodzinie dziadka 8086, który posiadał “ogromną” przestrzeń adresową – mógł zaadresować aż 16 megabajtów pamięci fizycznej oraz posiadał mechanizmy ochronny pamięci (czyli wykonywany aktualnie program/proces nie mógł “zajechać” w zasoby innego programu/procesu). Znane przysłowie “pierwsze śliwki robaczywki” w pełni sprawdziło się w tym przypadku. Ten model raczej należy uznać na nieudany. Jednak nie ma tego złego .... więc i80286 stanowił bazę rozwojową dla procesorów i80386, który już okazał się rozwiązaniem bardziej przemyślanym.
I80286 jest procesorem w pełni 16-bitowym (inaczej jak jego trochę kulawy dziadek i8088) i dysponuje 16-bitową szyną danych do pamięci. Pobierając kod rozkazu do wykonania, procesor odczytywał pamięć w trybie 16-bitowym. Oznacza to, że program zawarty w pamięci BIOS musi znajdować się pamięci 16-bitowej. Najczęściej stosowanym rozwiązaniem jest użycie dwóch układów 8-bitowych pamięci tylko do odczytu umieszczonej na wspólnej szynie adresowej i szyną danych przyłączonej do części młodszej oraz starszej szyny danych procesora.]Aby nie pomylić “połówek programu BIOS” jedna stanowi część młodszą (LOW) oraz starszą (HIGH). Na płytach głównych jest oznaczenie jaką część należy włożyć w daną podstawkę. Innym oznaczeniem występującym jest EVEN (parzysty: odpowiadający części młodszej) oraz, ODD (nieparzysty: odpowiadający części starszej).
Wracając jednak do tematu, to potrzebna jest jedynie karta kontrolera grafiki zgodna z VGA.Włączając “komputer” do pracy, procesor wykonuje program zawarty w pamięci BIOS (nasz BIOS), a jego zadaniem jest wygenerowanie obrazu zawierającego kolorowe linie pionowe, poziome (krata) oraz okrągłe dla monitora VGA. Pozwalało to na naprawę, diagnostykę i strojenie tych monitorów. Generator obrazu nie musiał ładować żadnego programu z dysku lub dyskietki. Realizował swoją funkcję natychmiast po włączeniu.Jeżeli ktoś jest przekonany, że program do umieszczenia w pamięci BIOS można pisać wyłącznie w języku asemblera, to muszę zaznaczyć, że jest w błędzie. Zaprezentowany program jest napisany w języku MODULA 2. Jestem przekonany, że ten język popularnością nie przebija przykładowo języka C. Porównując go do innych, to należy stwierdzić, że łączy pewne cechy języka PASCAL i języka C. Z PASCALA dziedziczy syntaktykę, jest ona podobna (a właściwie należy uznać, że jest uproszczeniem w stosunku do języka PASCAL). Podobnie jak w języku C, nie ma wbudowanej w język obsługi wejścia/wyjścia, odpowiednie procedury są dołączane jako biblioteki użytkowe.
Pisząc taki program należy mieć na uwadze, że program będzie pracował bez systemu operacyjnego. Właściwie sam sobie jest systemem operacyjnym, czyli możliwe jest przejęcie jakiegoś przerwania na siebie i użycia go: zamiast wywołania instrukcją call, będzie wywołanie instrukcją int – dziwaczne, ale możliwe. Na programie spoczywa obowiązek odpowiedniego zainicjowania i obsługi sprzętowej istotnych zespołów z płyty głównej (kontroler przerwań, kontroler DMA, układów czasowych itp). Oznacza to również, że nie można używać interrupt'ów do DOS'a (bo go nie ma – wyłączone są przykładowo funkcje przydziału pamięci, obsługi plików), interrupt'ów do BIOS'a (bo go nie ma – wyłączone są funkcje obsługi technicznej dysków, dyskietek, klawiatury, video..) ... a nie, nie. Video będzie działać, ponieważ BIOS od kontrolera video jest. Otóż, na kartach kontrolerów video jest BIOS zawierający obsługę właśnie tej karty. Należy ją jedynie aktywować, w wyniku której BIOS obsługi video przejmie na siebie przerwanie od “smarowania po ekranie”. Do włączenia przykładowo trybu graficznego (karta startuje w trybie alfanumerycznym) można użyć przerwania (int 10hex).
Program był tworzony i testowany pod kontrolą DOS'a jako typowa aplikacja (z ograniczeniem do minimum powiązania z systemem operacyjnym – jak najmniej przerwań do systemu). Pewne funkcje są używane, bo o ile załadowanie programu do pamięci operacyjnej realizowane przez system nie ma odbicia w kodzie, to zakończenie programu (i usunięcie z pamięci) już występuje. Dodatkowo, program jest sterowalny z klawiatury (chociażby by przekazać mu polecenie zakończenia pracy).
Po “wychuchaniu” programu, należy go “odwiązać” od systemu operacyjnego i jakoś zaaplikować do EPROM'a, ale to już temat na całkiem inne rozważania
ale możliwy do poruszenia na tym forum.Tekst programu (program napisany w języku programowania MODULA-2):
Kod: Zaznacz cały
(…)
MODULE VGARom ;
IMPORT SYSTEM ;
IMPORT Lib ;
IMPORT IO ;
TYPE
CHGArrT = ARRAY [ 0 .. 4095 ] OF SHORTCARD ;
CONST
CHGArr = CHGArrT (
000H,000H,000H,000H,000H,000H,000H,000H,
000H,000H,07EH,081H,0A5H,081H,081H,0BDH,
000H,000H,07EH,0FFH,0DBH,0FFH,0FFH,0C3H,
000H,000H,000H,036H,07FH,07FH,07FH,07FH,
000H,000H,000H,008H,01CH,03EH,07FH,03EH,
000H,000H,018H,03CH,03CH,0E7H,0E7H,0E7H,
000H,000H,018H,03CH,07EH,0FFH,0FFH,07EH,
000H,000H,000H,000H,000H,018H,03CH,03CH,
0FFH,0FFH,0FFH,0FFH,0FFH,0E7H,0C3H,0C3H,
000H,000H,000H,000H,03CH,066H,042H,042H,
0FFH,0FFH,0FFH,0FFH,0C3H,099H,0BDH,0BDH,
000H,000H,00FH,007H,00DH,019H,03CH,066H,
000H,000H,03CH,066H,066H,066H,03CH,018H,
000H,000H,03FH,033H,03FH,030H,030H,030H,
000H,000H,07FH,063H,07FH,063H,063H,063H,
000H,000H,018H,018H,0DBH,03CH,0E7H,03CH,
000H,000H,040H,060H,070H,07CH,07FH,07CH,
000H,000H,001H,003H,007H,01FH,07FH,01FH,
000H,000H,018H,03CH,07EH,018H,018H,018H,
000H,000H,033H,033H,033H,033H,033H,033H,
000H,000H,07FH,0DBH,0DBH,0DBH,07BH,01BH,
000H,03EH,063H,030H,01CH,036H,063H,063H,
000H,000H,000H,000H,000H,000H,000H,000H,
000H,000H,018H,03CH,07EH,018H,018H,018H,
000H,000H,018H,03CH,07EH,018H,018H,018H,
000H,000H,018H,018H,018H,018H,018H,018H,
000H,000H,000H,000H,00CH,006H,07FH,006H,
000H,000H,000H,000H,018H,030H,07FH,030H,
000H,000H,000H,000H,000H,060H,060H,060H,
000H,000H,000H,000H,024H,066H,0FFH,066H,
000H,000H,000H,008H,01CH,01CH,03EH,03EH,
000H,000H,000H,07FH,07FH,03EH,03EH,01CH,
000H,000H,000H,000H,000H,000H,000H,000H,
000H,000H,018H,03CH,03CH,03CH,018H,018H,
000H,063H,063H,063H,022H,000H,000H,000H,
000H,000H,036H,036H,07FH,036H,036H,036H,
00CH,00CH,03EH,063H,061H,060H,03EH,003H,
000H,000H,000H,000H,061H,063H,006H,00CH,
000H,000H,01CH,036H,036H,01CH,03BH,06EH,
000H,030H,030H,030H,060H,000H,000H,000H,
000H,000H,00CH,018H,030H,030H,030H,030H,
000H,000H,018H,00CH,006H,006H,006H,006H,
000H,000H,000H,000H,066H,03CH,0FFH,03CH,
000H,000H,000H,018H,018H,018H,0FFH,018H,
000H,000H,000H,000H,000H,000H,000H,000H,
000H,000H,000H,000H,000H,000H,0FFH,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
000H,000H,001H,003H,006H,00CH,018H,030H,
000H,000H,03EH,063H,067H,06FH,07BH,073H,
000H,000H,00CH,01CH,03CH,00CH,00CH,00CH,
000H,000H,03EH,063H,003H,006H,00CH,018H,
000H,000H,03EH,063H,003H,003H,01EH,003H,
000H,000H,006H,00EH,01EH,036H,066H,07FH,
000H,000H,07FH,060H,060H,060H,07EH,003H,
000H,000H,01CH,030H,060H,060H,07EH,063H,
000H,000H,07FH,063H,003H,006H,00CH,018H,
000H,000H,03EH,063H,063H,063H,03EH,063H,
000H,000H,03EH,063H,063H,063H,03FH,003H,
000H,000H,000H,018H,018H,000H,000H,000H,
000H,000H,000H,018H,018H,000H,000H,000H,
000H,000H,006H,00CH,018H,030H,060H,030H,
000H,000H,000H,000H,000H,07EH,000H,000H,
000H,000H,060H,030H,018H,00CH,006H,00CH,
000H,000H,03EH,063H,063H,006H,00CH,00CH,
000H,000H,03EH,063H,063H,06FH,06FH,06FH,
000H,000H,008H,01CH,036H,063H,063H,07FH,
000H,000H,07EH,033H,033H,033H,03EH,033H,
000H,000H,01EH,033H,061H,060H,060H,060H,
000H,000H,07CH,036H,033H,033H,033H,033H,
000H,000H,07FH,033H,031H,034H,03CH,034H,
000H,000H,07FH,033H,031H,034H,03CH,034H,
000H,000H,01EH,033H,061H,060H,060H,06FH,
000H,000H,063H,063H,063H,063H,07FH,063H,
000H,000H,03CH,018H,018H,018H,018H,018H,
000H,000H,00FH,006H,006H,006H,006H,006H,
000H,000H,073H,033H,036H,036H,03CH,036H,
000H,000H,078H,030H,030H,030H,030H,030H,
000H,000H,0C3H,0E7H,0FFH,0DBH,0C3H,0C3H,
000H,000H,063H,073H,07BH,07FH,06FH,067H,
000H,000H,01CH,036H,063H,063H,063H,063H,
000H,000H,07EH,033H,033H,033H,03EH,030H,
000H,000H,03EH,063H,063H,063H,063H,06BH,
000H,000H,07EH,033H,033H,033H,03EH,036H,
000H,000H,03EH,063H,063H,030H,01CH,006H,
000H,000H,0FFH,0DBH,099H,018H,018H,018H,
000H,000H,063H,063H,063H,063H,063H,063H,
000H,000H,0C3H,0C3H,0C3H,0C3H,0C3H,0C3H,
000H,000H,0C3H,0C3H,0C3H,0C3H,0DBH,0DBH,
000H,000H,0C3H,0C3H,066H,03CH,018H,03CH,
000H,000H,0C3H,0C3H,0C3H,066H,03CH,018H,
000H,000H,0FFH,0C3H,086H,00CH,018H,030H,
000H,000H,03CH,030H,030H,030H,030H,030H,
000H,000H,040H,060H,070H,038H,01CH,00EH,
000H,000H,03CH,00CH,00CH,00CH,00CH,00CH,
008H,01CH,036H,063H,000H,000H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
018H,018H,00CH,000H,000H,000H,000H,000H,
000H,000H,000H,000H,000H,03CH,006H,03EH,
000H,000H,070H,030H,030H,03CH,036H,033H,
000H,000H,000H,000H,000H,03EH,063H,060H,
000H,000H,00EH,006H,006H,01EH,036H,066H,
000H,000H,000H,000H,000H,03EH,063H,07FH,
000H,000H,01CH,036H,032H,030H,07CH,030H,
000H,000H,000H,000H,000H,03BH,066H,066H,
000H,000H,070H,030H,030H,036H,03BH,033H,
000H,000H,00CH,00CH,000H,01CH,00CH,00CH,
000H,000H,006H,006H,000H,00EH,006H,006H,
000H,000H,070H,030H,030H,033H,036H,03CH,
000H,000H,01CH,00CH,00CH,00CH,00CH,00CH,
000H,000H,000H,000H,000H,0E6H,0FFH,0DBH,
000H,000H,000H,000H,000H,06EH,033H,033H,
000H,000H,000H,000H,000H,03EH,063H,063H,
000H,000H,000H,000H,000H,06EH,033H,033H,
000H,000H,000H,000H,000H,03BH,066H,066H,
000H,000H,000H,000H,000H,06EH,03BH,033H,
000H,000H,000H,000H,000H,03EH,063H,038H,
000H,000H,008H,018H,018H,07EH,018H,018H,
000H,000H,000H,000H,000H,066H,066H,066H,
000H,000H,000H,000H,000H,0C3H,0C3H,0C3H,
000H,000H,000H,000H,000H,0C3H,0C3H,0DBH,
000H,000H,000H,000H,000H,063H,036H,01CH,
000H,000H,000H,000H,000H,063H,063H,063H,
000H,000H,000H,000H,000H,07FH,066H,00CH,
000H,000H,00EH,018H,018H,018H,070H,018H,
000H,000H,018H,018H,018H,018H,000H,018H,
000H,000H,070H,018H,018H,018H,00EH,018H,
000H,000H,03BH,06EH,000H,000H,000H,000H,
000H,000H,000H,000H,008H,01CH,036H,063H,
000H,000H,01EH,033H,061H,060H,060H,061H,
000H,000H,066H,066H,000H,066H,066H,066H,
000H,006H,00CH,018H,000H,03EH,063H,07FH,
000H,008H,01CH,036H,000H,03CH,006H,03EH,
000H,000H,066H,066H,000H,03CH,006H,03EH,
000H,030H,018H,00CH,000H,03CH,006H,03EH,
000H,01CH,036H,01CH,000H,03CH,006H,03EH,
000H,000H,000H,000H,03CH,066H,060H,066H,
000H,008H,01CH,036H,000H,03EH,063H,07FH,
000H,000H,066H,066H,000H,03EH,063H,07FH,
000H,030H,018H,00CH,000H,03EH,063H,07FH,
000H,000H,066H,066H,000H,038H,018H,018H,
000H,018H,03CH,066H,000H,038H,018H,018H,
000H,060H,030H,018H,000H,038H,018H,018H,
000H,063H,063H,008H,01CH,036H,063H,063H,
01CH,036H,01CH,000H,01CH,036H,063H,063H,
00CH,018H,030H,000H,07FH,033H,030H,03EH,
000H,000H,000H,000H,06EH,03BH,01BH,07EH,
000H,000H,01FH,036H,066H,066H,07FH,066H,
000H,008H,01CH,036H,000H,03EH,063H,063H,
000H,000H,063H,063H,000H,03EH,063H,063H,
000H,030H,018H,00CH,000H,03EH,063H,063H,
000H,018H,03CH,066H,000H,066H,066H,066H,
000H,030H,018H,00CH,000H,066H,066H,066H,
000H,000H,063H,063H,000H,063H,063H,063H,
000H,063H,063H,01CH,036H,063H,063H,063H,
000H,063H,063H,000H,063H,063H,063H,063H,
000H,018H,018H,07EH,0C3H,0C0H,0C0H,0C3H,
000H,01CH,036H,032H,030H,078H,030H,030H,
000H,000H,0C3H,066H,03CH,018H,0FFH,018H,
000H,0FCH,066H,066H,07CH,062H,066H,06FH,
000H,00EH,01BH,018H,018H,018H,07EH,018H,
000H,000H,008H,01CH,036H,063H,063H,07FH,
00CH,008H,01EH,033H,061H,060H,060H,060H,
000H,000H,07FH,033H,031H,034H,03CH,034H,
000H,000H,078H,033H,036H,03CH,038H,030H,
00CH,008H,063H,073H,07BH,07FH,06FH,067H,
00CH,008H,01CH,036H,063H,063H,063H,063H,
00CH,008H,03EH,063H,063H,030H,01CH,006H,
000H,000H,0FFH,0C3H,086H,00CH,07EH,030H,
00CH,008H,0FFH,0C3H,086H,00CH,018H,030H,
000H,000H,000H,000H,000H,000H,07FH,060H,
000H,000H,000H,000H,000H,03CH,006H,03EH,
000H,000H,000H,00CH,008H,03EH,063H,060H,
000H,000H,000H,000H,000H,03EH,063H,07FH,
000H,000H,01CH,00DH,00FH,00EH,01CH,03CH,
000H,000H,000H,00CH,008H,06EH,033H,033H,
000H,000H,000H,00CH,008H,03EH,063H,063H,
000H,000H,000H,00CH,008H,03EH,063H,038H,
000H,000H,00CH,00CH,000H,07FH,066H,00CH,
000H,000H,000H,00CH,008H,07FH,066H,00CH,
018H,018H,018H,018H,018H,018H,018H,018H,
018H,018H,018H,018H,018H,018H,018H,0F8H,
018H,018H,018H,018H,018H,0F8H,018H,0F8H,
036H,036H,036H,036H,036H,036H,036H,0F6H,
000H,000H,000H,000H,000H,000H,000H,0FEH,
000H,000H,000H,000H,000H,0F8H,018H,0F8H,
036H,036H,036H,036H,036H,0F6H,006H,0F6H,
036H,036H,036H,036H,036H,036H,036H,036H,
000H,000H,000H,000H,000H,0FEH,006H,0F6H,
036H,036H,036H,036H,036H,0F6H,006H,0FEH,
036H,036H,036H,036H,036H,036H,036H,0FEH,
018H,018H,018H,018H,018H,0F8H,018H,0F8H,
000H,000H,000H,000H,000H,000H,000H,0F8H,
018H,018H,018H,018H,018H,018H,018H,01FH,
018H,018H,018H,018H,018H,018H,018H,0FFH,
000H,000H,000H,000H,000H,000H,000H,0FFH,
018H,018H,018H,018H,018H,018H,018H,01FH,
000H,000H,000H,000H,000H,000H,000H,0FFH,
018H,018H,018H,018H,018H,018H,018H,0FFH,
018H,018H,018H,018H,018H,01FH,018H,01FH,
036H,036H,036H,036H,036H,036H,036H,037H,
036H,036H,036H,036H,036H,037H,030H,03FH,
000H,000H,000H,000H,000H,03FH,030H,037H,
036H,036H,036H,036H,036H,0F7H,000H,0FFH,
000H,000H,000H,000H,000H,0FFH,000H,0F7H,
036H,036H,036H,036H,036H,037H,030H,037H,
000H,000H,000H,000H,000H,0FFH,000H,0FFH,
036H,036H,036H,036H,036H,0F7H,000H,0F7H,
018H,018H,018H,018H,018H,0FFH,000H,0FFH,
036H,036H,036H,036H,036H,036H,036H,0FFH,
000H,000H,000H,000H,000H,0FFH,000H,0FFH,
000H,000H,000H,000H,000H,000H,000H,0FFH,
036H,036H,036H,036H,036H,036H,036H,03FH,
018H,018H,018H,018H,018H,01FH,018H,01FH,
000H,000H,000H,000H,000H,01FH,018H,01FH,
000H,000H,000H,000H,000H,000H,000H,03FH,
036H,036H,036H,036H,036H,036H,036H,0FFH,
018H,018H,018H,018H,018H,0FFH,018H,0FFH,
018H,018H,018H,018H,018H,018H,018H,0F8H,
000H,000H,000H,000H,000H,000H,000H,01FH,
0FFH,0FFH,0FFH,0FFH,0FFH,0FFH,0FFH,0FFH,
000H,000H,000H,000H,000H,000H,000H,0FFH,
0F0H,0F0H,0F0H,0F0H,0F0H,0F0H,0F0H,0F0H,
00FH,00FH,00FH,00FH,00FH,00FH,00FH,00FH,
0FFH,0FFH,0FFH,0FFH,0FFH,0FFH,0FFH,000H,
000H,000H,000H,000H,000H,03BH,06EH,06CH,
000H,000H,000H,000H,03EH,063H,07EH,063H,
000H,000H,07FH,063H,063H,060H,060H,060H,
000H,000H,000H,000H,07FH,036H,036H,036H,
000H,000H,07FH,063H,030H,018H,00CH,018H,
000H,000H,000H,000H,000H,03FH,06CH,06CH,
000H,000H,000H,000H,033H,033H,033H,033H,
000H,000H,000H,000H,03BH,06EH,00CH,00CH,
000H,000H,07EH,018H,03CH,066H,066H,066H,
000H,000H,01CH,036H,063H,063H,07FH,063H,
000H,000H,01CH,036H,063H,063H,063H,036H,
000H,000H,01EH,030H,018H,00CH,03EH,066H,
000H,000H,000H,000H,000H,07EH,0DBH,0DBH,
000H,000H,003H,006H,07EH,0DBH,0DBH,0F3H,
000H,000H,01CH,030H,060H,060H,07CH,060H,
000H,000H,000H,03EH,063H,063H,063H,063H,
000H,000H,000H,07FH,000H,000H,07FH,000H,
000H,000H,018H,018H,018H,0FFH,018H,018H,
000H,000H,030H,018H,00CH,006H,00CH,018H,
000H,000H,00CH,018H,030H,060H,030H,018H,
000H,000H,00EH,01BH,01BH,018H,018H,018H,
018H,018H,018H,018H,018H,018H,018H,018H,
000H,000H,018H,018H,000H,000H,0FFH,000H,
000H,000H,000H,000H,03BH,06EH,000H,03BH,
000H,038H,06CH,06CH,038H,000H,000H,000H,
000H,000H,000H,000H,000H,000H,018H,018H,
000H,000H,000H,000H,000H,000H,000H,018H,
000H,00FH,00CH,00CH,00CH,00CH,00CH,0ECH,
000H,0D8H,06CH,06CH,06CH,06CH,06CH,000H,
000H,070H,0D8H,030H,060H,0C8H,0F8H,000H,
000H,000H,000H,000H,03EH,03EH,03EH,03EH,
000H,000H,000H,000H,000H,000H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
099H,081H,07EH,000H,000H,000H,000H,000H,
0E7H,0FFH,07EH,000H,000H,000H,000H,000H,
03EH,01CH,008H,000H,000H,000H,000H,000H,
01CH,008H,000H,000H,000H,000H,000H,000H,
018H,018H,03CH,000H,000H,000H,000H,000H,
018H,018H,03CH,000H,000H,000H,000H,000H,
018H,000H,000H,000H,000H,000H,000H,000H,
0E7H,0FFH,0FFH,0FFH,0FFH,0FFH,000H,000H,
066H,03CH,000H,000H,000H,000H,000H,000H,
099H,0C3H,0FFH,0FFH,0FFH,0FFH,000H,000H,
066H,066H,03CH,000H,000H,000H,000H,000H,
07EH,018H,018H,000H,000H,000H,000H,000H,
070H,0F0H,0E0H,000H,000H,000H,000H,000H,
067H,0E7H,0E6H,0C0H,000H,000H,000H,000H,
0DBH,018H,018H,000H,000H,000H,000H,000H,
070H,060H,040H,000H,000H,000H,000H,000H,
007H,003H,001H,000H,000H,000H,000H,000H,
07EH,03CH,018H,000H,000H,000H,000H,000H,
000H,033H,033H,000H,000H,000H,000H,000H,
01BH,01BH,01BH,000H,000H,000H,000H,000H,
036H,01CH,006H,063H,03EH,000H,000H,000H,
07FH,07FH,07FH,000H,000H,000H,000H,000H,
07EH,03CH,018H,07EH,000H,000H,000H,000H,
018H,018H,018H,000H,000H,000H,000H,000H,
07EH,03CH,018H,000H,000H,000H,000H,000H,
00CH,000H,000H,000H,000H,000H,000H,000H,
018H,000H,000H,000H,000H,000H,000H,000H,
07FH,000H,000H,000H,000H,000H,000H,000H,
024H,000H,000H,000H,000H,000H,000H,000H,
07FH,07FH,000H,000H,000H,000H,000H,000H,
01CH,008H,000H,000H,000H,000H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
000H,018H,018H,000H,000H,000H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
07FH,036H,036H,000H,000H,000H,000H,000H,
043H,063H,03EH,00CH,00CH,000H,000H,000H,
018H,033H,063H,000H,000H,000H,000H,000H,
066H,066H,03BH,000H,000H,000H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
030H,018H,00CH,000H,000H,000H,000H,000H,
006H,00CH,018H,000H,000H,000H,000H,000H,
066H,000H,000H,000H,000H,000H,000H,000H,
018H,018H,000H,000H,000H,000H,000H,000H,
018H,018H,018H,030H,000H,000H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
000H,018H,018H,000H,000H,000H,000H,000H,
060H,040H,000H,000H,000H,000H,000H,000H,
063H,063H,03EH,000H,000H,000H,000H,000H,
00CH,00CH,03FH,000H,000H,000H,000H,000H,
030H,063H,07FH,000H,000H,000H,000H,000H,
003H,063H,03EH,000H,000H,000H,000H,000H,
006H,006H,00FH,000H,000H,000H,000H,000H,
003H,063H,03EH,000H,000H,000H,000H,000H,
063H,063H,03EH,000H,000H,000H,000H,000H,
018H,018H,018H,000H,000H,000H,000H,000H,
063H,063H,03EH,000H,000H,000H,000H,000H,
003H,006H,03CH,000H,000H,000H,000H,000H,
018H,018H,000H,000H,000H,000H,000H,000H,
018H,018H,030H,000H,000H,000H,000H,000H,
018H,00CH,006H,000H,000H,000H,000H,000H,
07EH,000H,000H,000H,000H,000H,000H,000H,
018H,030H,060H,000H,000H,000H,000H,000H,
000H,00CH,00CH,000H,000H,000H,000H,000H,
06EH,060H,03EH,000H,000H,000H,000H,000H,
063H,063H,063H,000H,000H,000H,000H,000H,
033H,033H,07EH,000H,000H,000H,000H,000H,
061H,033H,01EH,000H,000H,000H,000H,000H,
033H,036H,07CH,000H,000H,000H,000H,000H,
031H,033H,07FH,000H,000H,000H,000H,000H,
030H,030H,078H,000H,000H,000H,000H,000H,
063H,033H,01DH,000H,000H,000H,000H,000H,
063H,063H,063H,000H,000H,000H,000H,000H,
018H,018H,03CH,000H,000H,000H,000H,000H,
066H,066H,03CH,000H,000H,000H,000H,000H,
036H,033H,073H,000H,000H,000H,000H,000H,
031H,033H,07FH,000H,000H,000H,000H,000H,
0C3H,0C3H,0C3H,000H,000H,000H,000H,000H,
063H,063H,063H,000H,000H,000H,000H,000H,
063H,036H,01CH,000H,000H,000H,000H,000H,
030H,030H,078H,000H,000H,000H,000H,000H,
06FH,03EH,006H,007H,000H,000H,000H,000H,
033H,033H,073H,000H,000H,000H,000H,000H,
063H,063H,03EH,000H,000H,000H,000H,000H,
018H,018H,03CH,000H,000H,000H,000H,000H,
063H,063H,03EH,000H,000H,000H,000H,000H,
066H,03CH,018H,000H,000H,000H,000H,000H,
0FFH,066H,066H,000H,000H,000H,000H,000H,
066H,0C3H,0C3H,000H,000H,000H,000H,000H,
018H,018H,03CH,000H,000H,000H,000H,000H,
061H,0C3H,0FFH,000H,000H,000H,000H,000H,
030H,030H,03CH,000H,000H,000H,000H,000H,
007H,003H,001H,000H,000H,000H,000H,000H,
00CH,00CH,03CH,000H,000H,000H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
000H,000H,000H,000H,0FFH,000H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
066H,066H,03BH,000H,000H,000H,000H,000H,
033H,033H,06EH,000H,000H,000H,000H,000H,
060H,063H,03EH,000H,000H,000H,000H,000H,
066H,066H,03BH,000H,000H,000H,000H,000H,
060H,063H,03EH,000H,000H,000H,000H,000H,
030H,030H,078H,000H,000H,000H,000H,000H,
066H,03EH,006H,066H,03CH,000H,000H,000H,
033H,033H,073H,000H,000H,000H,000H,000H,
00CH,00CH,01EH,000H,000H,000H,000H,000H,
006H,006H,066H,066H,03CH,000H,000H,000H,
036H,033H,073H,000H,000H,000H,000H,000H,
00CH,00CH,01EH,000H,000H,000H,000H,000H,
0DBH,0DBH,0DBH,000H,000H,000H,000H,000H,
033H,033H,033H,000H,000H,000H,000H,000H,
063H,063H,03EH,000H,000H,000H,000H,000H,
033H,03EH,030H,030H,078H,000H,000H,000H,
066H,03EH,006H,006H,00FH,000H,000H,000H,
030H,030H,078H,000H,000H,000H,000H,000H,
00EH,063H,03EH,000H,000H,000H,000H,000H,
018H,01BH,00EH,000H,000H,000H,000H,000H,
066H,066H,03BH,000H,000H,000H,000H,000H,
066H,03CH,018H,000H,000H,000H,000H,000H,
0DBH,0FFH,066H,000H,000H,000H,000H,000H,
01CH,036H,063H,000H,000H,000H,000H,000H,
063H,03FH,003H,006H,03CH,000H,000H,000H,
018H,033H,07FH,000H,000H,000H,000H,000H,
018H,018H,00EH,000H,000H,000H,000H,000H,
018H,018H,018H,000H,000H,000H,000H,000H,
018H,018H,070H,000H,000H,000H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
063H,07FH,000H,000H,000H,000H,000H,000H,
033H,01EH,006H,003H,03EH,000H,000H,000H,
066H,066H,03BH,000H,000H,000H,000H,000H,
060H,063H,03EH,000H,000H,000H,000H,000H,
066H,066H,03BH,000H,000H,000H,000H,000H,
066H,066H,03BH,000H,000H,000H,000H,000H,
066H,066H,03BH,000H,000H,000H,000H,000H,
066H,066H,03BH,000H,000H,000H,000H,000H,
03CH,00CH,006H,03CH,000H,000H,000H,000H,
060H,063H,03EH,000H,000H,000H,000H,000H,
060H,063H,03EH,000H,000H,000H,000H,000H,
060H,063H,03EH,000H,000H,000H,000H,000H,
018H,018H,03CH,000H,000H,000H,000H,000H,
018H,018H,03CH,000H,000H,000H,000H,000H,
018H,018H,03CH,000H,000H,000H,000H,000H,
07FH,063H,063H,000H,000H,000H,000H,000H,
07FH,063H,063H,000H,000H,000H,000H,000H,
030H,033H,07FH,000H,000H,000H,000H,000H,
0D8H,0DCH,077H,000H,000H,000H,000H,000H,
066H,066H,067H,000H,000H,000H,000H,000H,
063H,063H,03EH,000H,000H,000H,000H,000H,
063H,063H,03EH,000H,000H,000H,000H,000H,
063H,063H,03EH,000H,000H,000H,000H,000H,
066H,066H,03BH,000H,000H,000H,000H,000H,
066H,066H,03BH,000H,000H,000H,000H,000H,
063H,03FH,003H,006H,03CH,000H,000H,000H,
063H,036H,01CH,000H,000H,000H,000H,000H,
063H,063H,03EH,000H,000H,000H,000H,000H,
07EH,018H,018H,000H,000H,000H,000H,000H,
030H,073H,07EH,000H,000H,000H,000H,000H,
0FFH,018H,018H,000H,000H,000H,000H,000H,
066H,066H,0F3H,000H,000H,000H,000H,000H,
018H,018H,018H,0D8H,070H,000H,000H,000H,
063H,063H,063H,006H,00CH,000H,000H,000H,
061H,033H,01EH,000H,000H,000H,000H,000H,
031H,033H,07FH,006H,00CH,000H,000H,000H,
071H,033H,07FH,000H,000H,000H,000H,000H,
063H,063H,063H,000H,000H,000H,000H,000H,
063H,036H,01CH,000H,000H,000H,000H,000H,
063H,063H,03EH,000H,000H,000H,000H,000H,
061H,0C3H,0FFH,000H,000H,000H,000H,000H,
061H,0C3H,0FFH,000H,000H,000H,000H,000H,
060H,060H,000H,000H,000H,000H,000H,000H,
066H,066H,03BH,006H,00CH,000H,000H,000H,
060H,063H,03EH,000H,000H,000H,000H,000H,
060H,063H,03EH,00CH,018H,000H,000H,000H,
06CH,04CH,01EH,000H,000H,000H,000H,000H,
033H,033H,033H,000H,000H,000H,000H,000H,
063H,063H,03EH,000H,000H,000H,000H,000H,
00EH,063H,03EH,000H,000H,000H,000H,000H,
018H,033H,07FH,000H,000H,000H,000H,000H,
018H,033H,07FH,000H,000H,000H,000H,000H,
018H,018H,018H,018H,018H,018H,000H,000H,
018H,018H,018H,018H,018H,018H,000H,000H,
018H,018H,018H,018H,018H,018H,000H,000H,
036H,036H,036H,036H,036H,036H,000H,000H,
036H,036H,036H,036H,036H,036H,000H,000H,
018H,018H,018H,018H,018H,018H,000H,000H,
036H,036H,036H,036H,036H,036H,000H,000H,
036H,036H,036H,036H,036H,036H,000H,000H,
036H,036H,036H,036H,036H,036H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
018H,018H,018H,018H,018H,018H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
018H,018H,018H,018H,018H,018H,000H,000H,
018H,018H,018H,018H,018H,018H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
018H,018H,018H,018H,018H,018H,000H,000H,
018H,018H,018H,018H,018H,018H,000H,000H,
036H,036H,036H,036H,036H,036H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
036H,036H,036H,036H,036H,036H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
036H,036H,036H,036H,036H,036H,000H,000H,
036H,036H,036H,036H,036H,036H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
036H,036H,036H,036H,036H,036H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
018H,018H,018H,018H,018H,018H,000H,000H,
036H,036H,036H,036H,036H,036H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
018H,018H,018H,018H,018H,018H,000H,000H,
036H,036H,036H,036H,036H,036H,000H,000H,
036H,036H,036H,036H,036H,036H,000H,000H,
018H,018H,018H,018H,018H,018H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
018H,018H,018H,018H,018H,018H,000H,000H,
0FFH,0FFH,0FFH,0FFH,0FFH,0FFH,000H,000H,
0FFH,0FFH,0FFH,0FFH,0FFH,0FFH,000H,000H,
0F0H,0F0H,0F0H,0F0H,0F0H,0F0H,000H,000H,
00FH,00FH,00FH,00FH,00FH,00FH,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
06CH,06EH,03BH,000H,000H,000H,000H,000H,
063H,07EH,060H,060H,020H,000H,000H,000H,
060H,060H,060H,000H,000H,000H,000H,000H,
036H,036H,036H,000H,000H,000H,000H,000H,
030H,063H,07FH,000H,000H,000H,000H,000H,
06CH,06CH,038H,000H,000H,000H,000H,000H,
03EH,030H,030H,060H,000H,000H,000H,000H,
00CH,00CH,00CH,000H,000H,000H,000H,000H,
03CH,018H,07EH,000H,000H,000H,000H,000H,
063H,036H,01CH,000H,000H,000H,000H,000H,
036H,036H,077H,000H,000H,000H,000H,000H,
066H,066H,03CH,000H,000H,000H,000H,000H,
07EH,000H,000H,000H,000H,000H,000H,000H,
07EH,060H,0C0H,000H,000H,000H,000H,000H,
060H,030H,01CH,000H,000H,000H,000H,000H,
063H,063H,063H,000H,000H,000H,000H,000H,
000H,07FH,000H,000H,000H,000H,000H,000H,
018H,000H,0FFH,000H,000H,000H,000H,000H,
030H,000H,07EH,000H,000H,000H,000H,000H,
00CH,000H,07EH,000H,000H,000H,000H,000H,
018H,018H,018H,018H,018H,018H,000H,000H,
0D8H,0D8H,070H,000H,000H,000H,000H,000H,
000H,018H,018H,000H,000H,000H,000H,000H,
06EH,000H,000H,000H,000H,000H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
06CH,03CH,01CH,000H,000H,000H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H,
03EH,03EH,000H,000H,000H,000H,000H,000H,
000H,000H,000H,000H,000H,000H,000H,000H) ;
CONST
dx = 2 ;
dy = 2 ;
VGAWidth = 640 ;
VGADepth = 480 ;
VGANumColor = 16 ;
TYPE
tinyint = [ 0 .. 7 ] ;
bs = SET OF tinyint ;
bp = POINTER TO bs ;
VAR
VGAScreen [ 0A000H : 0 ] : ARRAY [ 0 .. 0 ] OF bs ;
PROCEDURE GraphMode ;
VAR
r : SYSTEM . Registers ;
BEGIN (* GraphMode *)
r . AX := 12H ;
Lib . Intr ( r , 10H ) ;
END GraphMode ;
PROCEDURE TextMode ;
VAR
r : SYSTEM . Registers ;
BEGIN (* TextMode *)
r . AX := 3 ;
Lib . Intr ( r , 10H ) ;
END TextMode ;
PROCEDURE Plot( x,y,c : CARDINAL);
VAR
t : bs ;
p : CARDINAL ;
b : CARDINAL ;
s : CARDINAL ;
BEGIN (* Plot *)
IF ( x < VGAWidth ) AND ( y < VGADepth ) THEN
b := 1 << ( 7 - ( x MOD 8 ) ) ;
p := y * 80 + ( x DIV 8 ) ;
SYSTEM . Out ( 3CEH , 8 ) ;
SYSTEM . Out ( 3CFH , SHORTCARD ( b ) ) ;
SYSTEM . Out ( 3C4H , 2 ) ;
SYSTEM . Out ( 3C5H , 0FH ) ;
s := 0A000H ;
t := [ s : p bp ] ^ ;
[ s : p bp ] ^ := bs { } ;
SYSTEM . Out ( 3C4H , 2 ) ;
SYSTEM . Out ( 3C5H , SHORTCARD ( c ) ) ;
[ s : p bp ] ^ := bs { 0 .. 7 } ;
SYSTEM . Out ( 3CEH , 8 ) ;
SYSTEM . Out ( 3CFH , 0FFH ) ;
SYSTEM . Out ( 3C4H , 2 ) ;
SYSTEM . Out ( 3C5H , 0FH ) ;
END (* IF *) ;
END Plot ;
PROCEDURE Point ( x : CARDINAL ;
y : CARDINAL ) : CARDINAL ;
VAR
t : bs ;
p : CARDINAL ;
b : CARDINAL ;
s : CARDINAL ;
c : CARDINAL ;
BEGIN (* Point *)
IF ( x < VGAWidth ) AND ( y < VGADepth ) THEN
b := 1 << ( 7 - ( x MOD 8 ) ) ;
p := y * 80 + ( x DIV 8 ) ;
s := 0A000H ;
SYSTEM . Out ( 3CEH , 4 ) ; (* read map sel *)
SYSTEM . Out ( 3CFH , 3 ) ;
t := [ s : p bp ] ^ ;
t := t * bs ( b ) ;
c := CARDINAL ( SHORTCARD ( t ) ) ;
SYSTEM . Out ( 3CFH , 2 ) ;
t := [ s : p bp ] ^ ;
t := t * bs ( b ) ;
c := c * 2 + CARDINAL ( SHORTCARD ( t ) ) ;
SYSTEM . Out ( 3CFH , 1 ) ;
t := [ s : p bp ] ^ ;
t := t * bs ( b ) ;
c := c * 2 + CARDINAL ( SHORTCARD ( t ) ) ;
SYSTEM . Out ( 3CFH , 0 ) ;
t := [ s : p bp ] ^ ;
t := t * bs ( b ) ;
c := c * 2 + CARDINAL ( SHORTCARD ( t ) ) ;
c := c >> ( 7 - ( x MOD 8 ) ) ;
RETURN c ;
ELSE
RETURN 0 ;
END (* IF ... ELSE *) ;
END Point ;
PROCEDURE HLine ( x : CARDINAL ;
y : CARDINAL ;
x2 : CARDINAL ;
c : CARDINAL ) ;
VAR
c1 : CARDINAL ;
c2 : CARDINAL ;
BEGIN (* HLine *)
IF y > VGADepth - 1 THEN
RETURN ;
END (* IF *) ;
IF INTEGER ( x ) >= INTEGER ( VGAWidth ) THEN
RETURN ;
END (* IF *) ;
IF INTEGER ( x ) < 0 THEN
x := 0 ;
END (* IF *) ;
IF x2 >= VGAWidth THEN
x2 := VGAWidth - 1 ;
END (* IF *) ;
WHILE ( x MOD 8 # 0 ) AND ( x <= x2 ) DO
Plot ( x , y , c ) ;
INC ( x ) ;
END (* WHILE *) ;
WHILE ( x2 MOD 8 # 7 ) AND ( x <= x2 ) DO
Plot ( x2 , y , c ) ;
DEC ( x2 ) ;
END (* WHILE *) ;
IF INTEGER ( x ) > INTEGER ( x2 ) THEN
RETURN ;
END (* IF *) ;
SYSTEM . Out ( 3CEH , 8 ) ;
SYSTEM . Out ( 3CFH , 0FFH ) ;
SYSTEM . Out ( 3C4H , 2 ) ;
SYSTEM . Out ( 3C5H , 0FH ) ;
SYSTEM . Out ( 3CEH , 5 ) ;
SYSTEM . Out ( 3CFH , 2 ) ;
y := y * 80 ;
x := x DIV 8 ;
x2 := x2 DIV 8 ;
WHILE x <= x2 DO
VGAScreen [ y + x ] := bs ( c ) ;
INC ( x ) ;
END (* WHILE *) ;
SYSTEM . Out ( 3CEH , 5 ) ;
SYSTEM . Out ( 3CFH , 0 ) ;
END HLine ;
PROCEDURE Line ( x1 : CARDINAL ;
y1 : CARDINAL ;
x2 : CARDINAL ;
y2 : CARDINAL ;
c : CARDINAL ) ;
VAR
dx : INTEGER ;
dy : INTEGER ;
e : INTEGER ;
tmp : INTEGER ;
BEGIN (* Line *)
IF x1 > x2 THEN
tmp := x1 ;
x1 := x2 ;
x2 := tmp ;
tmp := y1 ;
y1 := y2 ;
y2 := tmp ;
END (* IF *) ;
dx := x2 - x1 ;
e := 0;
IF y1 <= y2 THEN (* case where y increases *)
dy := ( y2 - y1 ) ;
IF dx >= dy THEN
LOOP
Plot ( x1 , y1 , c ) ;
IF x1 = x2 THEN
EXIT ;
END (* IF *) ;
INC ( x1 ) ;
INC ( e , dy ) ;
INC ( e , dy ) ;
IF e > dx THEN
DEC ( e , dx ) ;
DEC ( e , dx ) ;
INC ( y1 ) ;
END (* IF *) ;
END (* LOOP *) ;
ELSE
LOOP
Plot ( x1,y1,c );
IF y1 = y2 THEN
EXIT ;
END (* IF *) ;
INC ( y1 ) ;
INC ( e , dx ) ;
INC ( e , dx ) ;
IF e > dy THEN
DEC ( e , dy ) ;
DEC ( e , dy ) ;
INC ( x1 ) ;
END (* IF *) ;
END (* LOOP *) ;
END (* IF ... ELSE *) ;
ELSE (* case where y decreases *)
dy := ( y1 - y2 ) ;
IF dx >= dy THEN
LOOP
Plot ( x1 , y1 , c ) ;
IF x1 = x2 THEN
EXIT ;
END (* IF *) ;
INC ( x1 ) ;
INC ( e , dy ) ;
INC ( e , dy ) ;
IF e > dx THEN
DEC ( e , dx ) ;
DEC ( e , dx ) ;
DEC ( y1 ) ;
END (* IF *) ;
END (* LOOP *) ;
ELSE
LOOP
Plot ( x1 , y1 , c ) ;
IF y1 = y2 THEN
EXIT ;
END (* IF *) ;
DEC ( y1 ) ;
INC ( e , dx ) ;
INC ( e , dx ) ;
IF e > dy THEN
DEC ( e , dy ) ;
DEC ( e , dy ) ;
INC ( x1 ) ;
END (* IF *) ;
END (* LOOP *) ;
END (* IF ... ELSE *) ;
END (* IF ... ELSE *) ;
END Line ;
PROCEDURE Disc ( x0 : CARDINAL ;
y0 : CARDINAL ;
r : CARDINAL ;
c : CARDINAL ) ;
VAR
e : INTEGER ;
x : CARDINAL ;
y : CARDINAL ;
BEGIN (* Disc *)
x := r ;
y := 0 ;
e := 0 ;
WHILE INTEGER ( y ) <= INTEGER ( x ) DO
HLine ( x0 - x , y0 + y , x0 + x , c ) ;
HLine ( x0 - x , y0 - y , x0 + x , c ) ;
INC ( y ) ;
INC ( e , y * dy - 1 ) ;
IF e > INTEGER ( x ) THEN
DEC ( x ) ;
DEC ( e , x * dx + 1 ) ;
HLine ( x0 - y , y0 + x , x0 + y , c ) ;
HLine ( x0 - y , y0 - x , x0 + y , c ) ;
END (* IF *) ;
END (* WHILE *) ;
END Disc ;
PROCEDURE Circle ( x0 : CARDINAL ;
y0 : CARDINAL ;
r : CARDINAL ;
c : CARDINAL ) ;
VAR
e : INTEGER ;
x : CARDINAL ;
y : CARDINAL ;
BEGIN (* Circle *)
x := r ;
y := 0 ;
e := 0 ;
WHILE INTEGER ( y ) <= INTEGER ( x ) DO
Plot ( x0 + x , y0 + y , c ) ;
Plot ( x0 - x , y0 + y , c ) ;
Plot ( x0 + x , y0 - y , c ) ;
Plot ( x0 - x , y0 - y , c ) ;
Plot ( x0 + y , y0 + x , c ) ;
Plot ( x0 - y , y0 + x , c ) ;
Plot ( x0 + y , y0 - x , c ) ;
Plot ( x0 - y , y0 - x , c ) ;
INC ( y ) ;
INC ( e , y * dy - 1 ) ;
IF e > INTEGER ( x ) THEN
DEC ( x ) ;
DEC ( e , x * dx + 1 ) ;
END (* IF *) ;
END (* IF *) ;
END Circle ;
PROCEDURE Ellipse ( x0 : CARDINAL ; (* center *)
y0 : CARDINAL ; (* center *)
a0 : CARDINAL ; (* semi-axes *)
b0 : CARDINAL ; (* semi-axes *)
c : CARDINAL ; (* color *)
fill : BOOLEAN ) ; (* wether filled *)
VAR
x : CARDINAL ;
y : CARDINAL ;
a : LONGINT ;
b : LONGINT ;
asq : LONGINT ;
asq2 : LONGINT ;
bsq : LONGINT ;
bsq2 : LONGINT ;
d : LONGINT ;
dx : LONGINT ;
dy : LONGINT ;
BEGIN (* Ellipse *)
x := 0 ;
y := b0 ;
a := LONGINT ( a0 ) ;
b := LONGINT ( b0 ) ;
asq := a * a ;
asq2 := asq * 2 ;
bsq := b * b ;
bsq2 := bsq * 2 ;
d := bsq - ( asq * b ) + ( asq DIV 4 ) ;
dx := 0 ;
dy := asq2 * b ;
WHILE dx < dy DO
IF fill THEN
HLine ( x0 - x , y0 + y , x0 + x , c ) ;
HLine ( x0 - x , y0 - y , x0 + x , c ) ;
ELSE
Plot ( x0 + x , y0 + y , c ) ;
Plot ( x0 - x , y0 + y , c ) ;
Plot ( x0 + x , y0 - y , c ) ;
Plot ( x0 - x , y0 - y , c ) ;
END (* IF ... ELSE *) ;
IF d > 0 THEN
DEC ( y ) ;
DEC ( dy , asq2 ) ;
DEC ( d , dy ) ;
END (* IF *) ;
INC ( x ) ;
INC ( dx , bsq2 ) ;
INC ( d , bsq + dx ) ;
END (* WHILE *) ;
INC ( d , ( 3 * ( asq - bsq ) DIV 2 - ( dx + dy ) ) DIV 2 ) ;
WHILE INTEGER ( y ) >= 0 DO
IF fill THEN
HLine ( x0 - x , y0 + y , x0 + x , c ) ;
HLine ( x0 - x , y0 - y , x0 + x , c ) ;
ELSE
Plot ( x0 + x , y0 + y , c ) ;
Plot ( x0 - x , y0 + y , c ) ;
Plot ( x0 + x , y0 - y , c ) ;
Plot ( x0 - x , y0 - y , c ) ;
END (* IF ... ELSE *) ;
IF d < 0 THEN
INC ( x ) ;
INC ( dx , bsq2 ) ;
INC ( d , dx ) ;
END (* IF *) ;
DEC ( y ) ;
DEC ( dy , asq2 ) ;
INC ( d , asq - dy ) ;
END (* WHILE *) ;
END Ellipse ;
PROCEDURE Polygon ( n : CARDINAL ;
px : ARRAY OF CARDINAL ;
py : ARRAY OF CARDINAL ;
c : CARDINAL ) ;
CONST
MaxPts = 20 ;
VAR
y : INTEGER ;
miny : INTEGER ;
maxy : INTEGER ;
x0 : INTEGER ;
y0 : INTEGER ;
x1 : INTEGER ;
y1 : INTEGER ;
temp : INTEGER ;
i : INTEGER ;
edge : INTEGER ;
next_edge : INTEGER ;
active : INTEGER ;
xord : ARRAY [ 0 .. MaxPts ] OF INTEGER ;
x : ARRAY [ 0 .. MaxPts ] OF CARDINAL ;
e : ARRAY [ 0 .. MaxPts ] OF INTEGER ;
PROCEDURE quicksort ( l : INTEGER ;
r : INTEGER ) ;
VAR
i : INTEGER ;
j : INTEGER ;
temp : INTEGER ;
key : CARDINAL ;
BEGIN (* quicksort *)
WHILE ( l < r ) DO
i := l ;
j := r ;
key := x [ xord [ j ] ] ;
REPEAT
WHILE ( i < j ) AND ( x [ xord [ i ] ] <= key ) DO
i := i + 1 ;
END (* WHILE *) ;
WHILE ( i < j ) AND ( key <= x [ xord [ j ] ] ) DO
j := j - 1 ;
END (* WHILE *) ;
IF i < j THEN
temp := xord [ i ] ;
xord [ i ] := xord [ j ] ;
xord [ j ] := temp ;
END (* IF *) ;
UNTIL ( i >= j ) ;
temp := xord [ i ] ;
xord [ i ] := xord [ r ] ;
xord [ r ] := temp ;
IF ( i - l < r - i ) THEN
quicksort ( l , i - 1 ) ;
l := i + 1 ;
ELSE
quicksort ( i + 1 , r ) ;
r := i - 1 ;
END (* IF ... ELSE *) ;
END (* WHILE *) ;
END quicksort ;
BEGIN (* Polygon *)
IF n > MaxPts THEN
n := MaxPts ;
END (* IF *) ;
miny := py [ 0 ] ;
maxy := miny ;
FOR i := 0 TO n - 1 DO
IF INTEGER ( py [ i ] ) < miny THEN
miny := py [ i ] ;
END (* IF *) ;
IF INTEGER ( py [ i ] ) > maxy THEN
maxy := py [ i ] ;
END (* IF *) ;
END (* FOR *) ;
FOR y := miny TO maxy DO
active := - 1 ;
FOR edge := 0 TO n - 1 DO
IF edge = INTEGER ( n - 1 ) THEN
next_edge := 0 ;
ELSE
next_edge := edge + 1 ;
END (* IF ... ELSE *) ;
x0 := px [ edge ] ;
y0 := py [ edge ] ;
x1 := px [ next_edge ] ;
y1 := py [ next_edge ] ;
IF y0 > y1 THEN
temp := x0 ;
x0 := x1 ;
x1 := temp ;
temp := y0 ;
y0 := y1 ;
y1 := temp ;
END (* IF *) ;
IF y = y0 THEN
e [ edge ] := 0 ;
x [ edge ] := x0 ;
ELSIF ( y0 <= y ) AND ( y <= y1 ) THEN
IF x1 >= x0 THEN (* x increases with y *)
INC ( e [ edge ] , 2 * ( x1 - x0 ) ) ;
WHILE e [ edge ] > INTEGER ( y1 - y0 ) DO
DEC ( e [ edge ] , 2 * ( y1 - y0 ) ) ;
INC ( x [ edge ] ) ;
END (* WHILE *) ;
ELSE (* x decreases with y *)
INC ( e [ edge ] , 2 * ( x0 - x1 ) ) ;
WHILE e [ edge ] > INTEGER ( y1 - y0 ) DO
DEC ( e [ edge ] , 2 * ( y1 - y0 ) ) ;
DEC ( x [ edge ] ) ;
END (* WHILE *) ;
END (* IF ... ELSE *) ;
active := active + 1 ;
xord [ active ] := edge ;
END (* IF ... ELSEIF *) ;
END (* FOR *) ;
quicksort ( 0 , active ) ;
i := 0 ;
WHILE i < active DO
HLine ( x [ xord [ i ] ] , y , x [ xord [ i + 1 ] ] , c ) ;
i := i + 2 ;
END (* WHILE *) ;
END (* FOR *) ;
END Polygon ;
CONST
White = 15 ;
Black = 0 ;
CONST
WindFrX = 55 ; (* 135 ; *)
WindFrY = 155 ; (* 155 ; *)
WindToX = 427 ; (* 507 ; *)
WindToY = 327 ; (* 327 ; *)
ColorFrameXSize = 60 ;
ColorFrameYSize = 40 ;
TYPE
RunAttrType = ( ResetType ,
MonoType ,
NoFrame ,
FrameOnly ,
ColorPlace ,
ColPlaceCycle ,
LoopCycle ) ;
VAR
RunAttr : RunAttrType ;
Color : CARDINAL ;
ColorXCoord : CARDINAL ;
ColorYCoord : CARDINAL ;
PlaceColor : CARDINAL ;
ColorRunMode : BOOLEAN ;
Ch : CHAR ;
PROCEDURE IncColor ( VAR ColorToInc : CARDINAL ) ;
BEGIN (* IncColor *)
IF ColorRunMode THEN
INC ( ColorToInc ) ;
ColorToInc := ColorToInc MOD 16 ;
IF ColorToInc = 0 THEN
ColorToInc := 1 ;
END (* IF *) ;
END (* IF *) ;
END IncColor ;
PROCEDURE Frame ( FromX : CARDINAL ;
FromY : CARDINAL ;
ToX : CARDINAL ;
ToY : CARDINAL ;
Color : CARDINAL ) ;
BEGIN (* Frame *)
Line ( FromX , FromY + 0 , ToX , FromY + 0 , Color ) ;
Line ( FromX , FromY + 1 , ToX , FromY + 1 , Color ) ;
Line ( FromX , FromY + 2 , ToX , FromY + 2 , Color ) ;
Line ( FromX , ToY - 2 , ToX , ToY - 2 , Color ) ;
Line ( FromX , ToY - 1 , ToX , ToY - 1 , Color ) ;
Line ( FromX , ToY - 0 , ToX , ToY - 0 , Color ) ;
Line ( FromX + 0 , FromY , FromX + 0 , ToY , Color ) ;
Line ( FromX + 1 , FromY , FromX + 1 , ToY , Color ) ;
Line ( FromX + 2 , FromY , FromX + 2 , ToY , Color ) ;
Line ( ToX - 2 , FromY , ToX - 2 , ToY , Color ) ;
Line ( ToX - 1 , FromY , ToX - 1 , ToY , Color ) ;
Line ( ToX - 0 , FromY , ToX - 0 , ToY , Color ) ;
END Frame ;
PROCEDURE FillSquare ( FromX : CARDINAL ;
FromY : CARDINAL ;
ToX : CARDINAL ;
ToY : CARDINAL ;
Color : CARDINAL ) ;
VAR
Loop : CARDINAL ;
BEGIN (* FillSquare *)
FOR Loop := FromY TO ToY DO
HLine ( FromX , Loop , ToX , Color ) ;
END (* FOR *) ;
END FillSquare ;
PROCEDURE DrawAP ( XCoord : CARDINAL ;
YCoord : CARDINAL ;
BackGrCol : CARDINAL ;
APColor : CARDINAL ) ;
CONST
APSize = 18 ;
TYPE
CoordArrType = ARRAY [ 0 .. APSize - 1 ] OF CARDINAL ;
CONST
FromX = CoordArrType ( 0 , 0 , 1 , 1 , 0 , 1 , 20 , 19 , 2 ,
3 , 11 , 10 , 5 , 4 , 11 , 12 , 16 , 17 ) ;
FromY = CoordArrType ( 0 , 0 , 1 , 1 , 15 , 14 , 0 , 1 , 12 ,
12 , 3 , 4 , 9 , 10 , 3 , 3 , 3 , 4 ) ;
ToX = CoordArrType ( 0 , 20 , 1 , 19 , 20 , 19 , 20 , 19 , 11 ,
12 , 16 , 17 , 17 , 16 , 11 , 12 , 16 , 17 ) ;
ToY = CoordArrType ( 15 , 0 , 14 , 1 , 15 , 14 , 15 , 14 , 3 ,
3 , 3 , 4 , 9 , 10 , 12 , 12 , 10 , 9 ) ;
VAR
Loop : CARDINAL ;
BEGIN (* DrawAP *)
FillSquare ( XCoord , YCoord , XCoord + 20 , YCoord + 15 , BackGrCol ) ;
FOR Loop := 0 TO APSize - 1 DO
Line ( XCoord + FromX [ Loop ] , YCoord + FromY [ Loop ] ,
XCoord + ToX [ Loop ] , YCoord + ToY [ Loop ] , APColor ) ;
END (* FOR *) ;
END DrawAP ;
PROCEDURE DrawText ( XCoord : CARDINAL ;
YCoord : CARDINAL ;
Color : CARDINAL ;
Size : CARDINAL ;
Text : ARRAY OF CHAR ) ;
VAR
Loop : CARDINAL ;
Ch : CHAR ;
PROCEDURE PlotCh ( XC : CARDINAL ;
YC : CARDINAL ;
Color : CARDINAL ;
CurCh : CHAR ) ;
VAR
Row : CARDINAL ;
Col : CARDINAL ;
Card : CARDINAL ;
ChCode : CARDINAL ;
LineLoop : CARDINAL ;
EndLoop : CARDINAL ;
Bits : BITSET ;
PlotXCoord : CARDINAL ;
PlotYCoord : CARDINAL ;
BEGIN (* PlotCh *)
ChCode := ORD ( CurCh ) ;
FOR Row := 0 TO 15 DO
IF Row < 8 THEN
Card := VAL ( CARDINAL , CHGArr [ ChCode * 8 + Row ] ) ;
ELSE
Card := VAL ( CARDINAL , CHGArr [ ( ChCode * 8 + Row - 8 ) + 2048 ] ) ;
END (* IF ... ELSE *) ;
Bits := BITSET ( Card ) ;
FOR Col := 0 TO 7 DO
IF Col IN Bits THEN
PlotXCoord := XC + ( 7 - Col ) * Size ;
PlotYCoord := YC + Row * Size ;
EndLoop := Size - 1 ;
FOR LineLoop := 0 TO EndLoop DO
Line ( PlotXCoord , PlotYCoord + LineLoop ,
PlotXCoord + EndLoop , PlotYCoord + LineLoop ,
Color ) ;
END (* FOR *) ;
END (* IF *) ;
END (* FOR *) ;
END (* FOR *) ;
END PlotCh ;
BEGIN (* DrawText *)
FOR Loop := 0 TO HIGH ( Text ) DO
Ch := Text [ Loop ] ;
IF Ch = 0C THEN
RETURN ;
END (* IF *) ;
PlotCh ( XCoord , YCoord , Color , Ch ) ;
XCoord := XCoord + 9 * Size ;
END (* FOR *) ;
END DrawText ;
PROCEDURE Window ( FromX : CARDINAL ;
FromY : CARDINAL ;
ToX : CARDINAL ;
ToY : CARDINAL ;
FrameCol : CARDINAL ;
BackgrCol : CARDINAL ) ;
BEGIN (* Window *)
Frame ( FromX , FromY , ToX , ToY , FrameCol ) ;
FillSquare ( FromX + 3 , FromY + 3 , ToX - 3 , ToY - 3 , BackgrCol ) ;
END Window ;
PROCEDURE WindowStep ;
BEGIN (* WindowStep *)
ColorYCoord := ColorYCoord + 55 ;
END WindowStep ;
PROCEDURE SetStartColor ( VAR Color : CARDINAL ) ;
BEGIN (* SetStartColor *)
IF ColorRunMode THEN
Color := 0 ;
ELSE
Color := 7 ;
END (* IF ... ELSE *) ;
END SetStartColor ;
PROCEDURE SetColor ( VAR RealColor : CARDINAL ;
Color : CARDINAL ) ;
BEGIN (* SetColor *)
IF ColorRunMode THEN
RealColor := Color ;
ELSE
RealColor := 7 ;
END (* IF ... ELSE *) ;
END SetColor ;
PROCEDURE DrawPart1 ;
VAR
Loop : CARDINAL ;
BEGIN (* DrawPart1 *)
SetStartColor ( Color ) ;
FOR Loop := 0 TO 480 BY 20 DO
Line ( 0 , Loop , 639 , Loop , Color ) ;
Line ( 0 , Loop + 1 , 639 , Loop + 1 , Color ) ;
Line ( 0 , Loop + 2 , 639 , Loop + 2 , Color ) ;
Line ( 0 , Loop + 3 , 639 , Loop + 3 , Color ) ;
IncColor ( Color ) ;
END (* FOR *) ;
SetStartColor ( Color ) ;
FOR Loop := 0 TO 630 BY 20 DO
Line ( Loop , 0 , Loop , 479 , Color ) ;
Line ( Loop + 1 , 0 , Loop + 1 , 479 , Color ) ;
Line ( Loop + 2 , 0 , Loop + 2 , 479 , Color ) ;
Line ( Loop + 3 , 0 , Loop + 3 , 479 , Color ) ;
IncColor ( Color ) ;
END (* FOR *) ;
Color := White ;
Frame ( 0 , 0 , 639 , 479 , Color ) ;
END DrawPart1 ;
PROCEDURE DrawPart2 ;
VAR
Loop : CARDINAL ;
BEGIN (* DrawPart2 *)
Color := White ;
Circle ( 239 , 239 , 220 , Color ) ;
Circle ( 239 , 239 , 221 , Color ) ;
Circle ( 239 , 239 , 222 , Color ) ;
Circle ( 239 , 239 , 223 , Color ) ;
Circle ( 239 , 239 , 224 , Color ) ;
Circle ( 239 , 239 , 225 , Color ) ;
Circle ( 239 , 239 , 226 , Color ) ;
Window ( WindFrX , WindFrY , WindToX , WindToY , White , Black ) ;
SetColor ( Color , 12 ) ;
DrawText ( WindFrX + 80 , WindFrY + 20 , Color , 4 , 'SIGNUM' ) ;
DrawText ( WindFrX + 60 , WindFrY + 80 , Color , 4 , 'Co. Ltd.' ) ;
Window ( 100 , 340 , 385 , 395 , White , Black ) ;
SetColor ( Color , 10 ) ;
DrawText ( 120 , 350 , Color , 1 , 'Generator sygnau wizji dla' ) ;
DrawText ( 150 , 370 , Color , 1 , 'monitorŻw VGA / SVGA' ) ;
Window ( 90 , 90 , 385 , 135 , White , Black ) ;
DrawText ( 115 , 100 , Color , 2 , 'Biaystok 1995' ) ;
ColorXCoord := 490 ;
ColorYCoord := 30 ;
FOR Loop := 0 TO 7 DO
SetColor ( Color , Loop ) ;
Window ( ColorXCoord , ColorYCoord , ColorXCoord + ColorFrameXSize ,
ColorYCoord + ColorFrameYSize , White , Color ) ;
WindowStep ;
END (* FOR *) ;
ColorXCoord := 560 ;
ColorYCoord := 30 ;
FOR Loop := 8 TO 15 DO
SetColor ( Color , Loop ) ;
Window ( ColorXCoord , ColorYCoord , ColorXCoord + ColorFrameXSize ,
ColorYCoord + ColorFrameYSize , White , Color ) ;
WindowStep ;
END (* FOR *) ;
SetColor ( Color , 13 ) ;
DrawAP ( 25 , 430 , Black , Color ) ;
END DrawPart2 ;
PROCEDURE DrawAll ;
BEGIN (* DrawAll *)
GraphMode ;
DrawPart1 ;
DrawPart2 ;
END DrawAll ;
PROCEDURE DrawFrame ;
BEGIN (* DrawFrame *)
GraphMode ;
DrawPart1 ;
END DrawFrame ;
PROCEDURE DrawNoFrame ;
BEGIN (* DrawNoFrame *)
GraphMode ;
Frame ( 0 , 0 , 639 , 479 , White ) ;
DrawPart2 ;
END DrawNoFrame ;
PROCEDURE DrawNextColorPlace ;
BEGIN (* DrawNextColorPlace *)
Window ( 80 , 40 , 560 , 440 , White , PlaceColor ) ;
DrawText ( 150 , 150 , 15 - PlaceColor , 6 , 'SIGNUM' ) ;
DrawText ( 120 , 250 , 15 - PlaceColor , 6 , 'Co. Ltd.' ) ;
INC ( PlaceColor ) ;
PlaceColor := PlaceColor MOD 16 ;
END DrawNextColorPlace ;
PROCEDURE DrawColorPlace ;
BEGIN (* DrawColorPlace *)
ColorRunMode := TRUE ;
GraphMode ;
DrawPart1 ;
DrawNextColorPlace ;
END DrawColorPlace ;
BEGIN (* VGARom *)
RunAttr := ResetType ;
LOOP
CASE RunAttr OF
ResetType :
ColorRunMode := TRUE ;
DrawAll ;
| MonoType :
ColorRunMode := FALSE ;
DrawAll ;
| FrameOnly :
DrawFrame ;
| NoFrame :
DrawNoFrame ;
| ColorPlace :
PlaceColor := 0 ;
DrawColorPlace ;
| ColPlaceCycle :
DrawNextColorPlace ;
| LoopCycle :
;
ELSE
RunAttr := ResetType ;
END (* CASE *) ;
Ch := IO . RdKey ( ) ;
CASE Ch OF
'1' :
RunAttr := MonoType ;
| '2' :
RunAttr := ResetType ;
| '3' :
RunAttr := NoFrame ;
| '4' :
RunAttr := FrameOnly ;
| '5' :
RunAttr := ColorPlace ;
| '6' :
IF RunAttr = ColorPlace THEN
RunAttr := ColPlaceCycle ;
ELSE
IF RunAttr <> ColPlaceCycle THEN
RunAttr := LoopCycle ;
END (* IF *) ;
END (* IF ... ELSE *) ;
| 'q' :
EXIT ;
ELSE
RunAttr := LoopCycle ;
END (* CASE *) ;
END (* LOOP *) ;
TextMode ;
END VGARom.