AMIGA E - Prakticky III. díl
Strašně moc se omlouvám, že dnes nebude další pokračování seriálu o éčku. Poslední
měsíc jsem byl dost busy a tak jsem neměl čas (znáte to: škola...). Ale nebyla to jen
škola, co mi znemožnilo napsat další canc o éčku. Dost času mi taky vzalo kódování
enginu pro AP (těšte se!).
So, sorry!
Aby jste neřekli, že na to kašlu, tak vám dám tenhlecten zdroják. Je to téměř dokončenej
skanner pro AmigaGuide. Stačí ho jen doplnit o několik tagů a je kompletní. Taky funkci
pro syntaktickou kontrolu si musíte napsat sami (je to trivialita...:-).
Sorry a čau!
E.N.I.F.
CONST
MAXIDLEN = 32, -> max. délka jména fontu (nebo souboru)
MAXSTRING = 256 -> max. délka řetězce
-> neznámej konec souboru konec řádky
ENUM SYM_UNKNOWN = 256, SYM_EOF, SYM_EOLN, -> aguide symboly
SYM_BRAC, SYM_KET, -> závorky "{" a "}"
SYM_STRING, -> řetězec
SYM_CONST, -> konstanta
SYM_FONTNAME, -> jméno fontu
SYM_FG, SYM_APEN, SYM_BG, SYM_BPEN, SYM_PARD,
SYM_FONT,
SYM_B, SYM_UB, SYM_I, SYM_UI, SYM_U, SYM_UU, SYM_PLAIN,
SYM_JCENTER, SYM_JLEFT, SYM_JRIGHT,
SYM_DATABASE, SYM_INDEX, SYM_REM, SYM_TITLE,
SYM_NODE, SYM_MAIN, SYM_ENDNODE,
SYM_LINK, SYM_SYSTEM,
SYM_TEXT, SYM_SHINE, SYM_SHADOW, SYM_FILL, SYM_FILLTEXT, SYM_BACKGROUND, SYM_HIGHLIGHT
DEF ident[MAXIDLEN]:STRING, -> název fontu, ...
poms[5]:STRING, -> pomocnej řetězec pro uložení posledních 5 znaků ident[]u
textstring[MAXSTRING]:STRING, -> název nodu, CLI příkaz, ...
znak = 0, -> sem se načítají znaky ze source[]
sym, -> kód symbolu
source, -> ukazatel na zdroják
sourcelen = 88, -> délka textu source[]
count = 0, -> pozice v source[]
num:LONG -> hodnota číselné konstanty
/**************************************************************************************************/
PROC main()
-> takto vmontovaný zdrojový AGuide text je POUZE pro testování
source := '@{B}dgvss@{bg text} @{jleft}\n@font shit.font 5\n@title "shit"\nndh\0'
WriteF('Zdojacek byl:\n\s\n', source) -> pro kontrolu vypíšeme source
WriteF('*ENDSOURCE*\n\n')
getchar() -> načíst první znak textu
WHILE (znak <> 0) -> dokud nejsme na konci souboru
IF znak = "@" -> tagy začínají znakem @
getchar() -> další znak
getsym() -> zjistit symbol
evaltags() -> projet tag
ENDIF
-> WriteF('znak = \c, count = \d, sym = \d, ident = \s\n', znak, count, sym, ident) -> DEBUG!?
getchar() -> další znak
ENDWHILE
WriteF('*END*\n')
ENDPROC -> a šlus...
/**************************************************************************************************/
/*
GetChar()
- čte znak ze source a ukládá ho do proměnné znak. Posouvá pozici v source o 1 a pozici ukládá
do proměnné count.
- hlídá konec souboru - vrací 0
- nutno volat pro čtení každého znaku.
*/
PROC getchar()
IF count < sourcelen
znak := source[count]
-> WriteF('znak=\d\n', znak) -> DEBUG!?
count ++
ELSE
znak := 0
ENDIF
ENDPROC znak
/**************************************************************************************************/
/*
GetSym()
- vyhledává AmigaGuide symboly. Může být volána pouze po znaku @.
- vrací kód symbolu v proměnné sym, hodnotu konstanty v num, obsah řetězce v textstring a
jméno fontu v ident.
- prohledávání končí na prvním znaku za symbolem.
*/
PROC getsym()
DEF i
WHILE (znak = 32) OR (znak ="\t" ) -> přeskoč mezery a tabulátory
getchar()
ENDWHILE
SELECT 256 OF znak -> rozhodni podle znaku (0 - 255)
CASE "A" TO "Z", "a" TO "z" -> písmeno = tagname
i := 0
IF (znak > 96) AND (znak < 123) THEN znak := znak - 32 -> převod "a" - "z" na "A" - "Z"
WHILE (((znak > 64) AND (znak < 91)) OR (znak = ".")) AND (i < MAXIDLEN - 1) -> "A" - "Z", "."
ident[i] := znak
i++ -> zde se kopírují znaky ze source do ident[]
getchar()
IF (znak > 96) AND (znak < 123) THEN znak := znak - 32 -> převod na velká písmena
ENDWHILE
ident[i] := 0 -> ukončení řetězce v ident
IF StrCmp(ident, 'FG', ALL) -> určení, co je TO za tag
sym := SYM_FG -> (porovnávání řetězců)
ELSEIF StrCmp(ident, 'APEN', ALL)
sym := SYM_APEN -> vracení kódu tagu
ELSEIF StrCmp(ident, 'BG', ALL)
sym := SYM_BG
ELSEIF StrCmp(ident, 'BPEN', ALL)
sym := SYM_BPEN
ELSEIF StrCmp(ident, 'PARD', ALL)
sym := SYM_PARD
ELSEIF StrCmp(ident, 'FONT', ALL)
sym := SYM_FONT
ELSEIF StrCmp(ident, 'B', ALL)
sym := SYM_B
ELSEIF StrCmp(ident, 'UB', ALL)
sym := SYM_UB
ELSEIF StrCmp(ident, 'I', ALL)
sym := SYM_I
ELSEIF StrCmp(ident, 'UI', ALL)
sym := SYM_UI
ELSEIF StrCmp(ident, 'U', ALL)
sym := SYM_U
ELSEIF StrCmp(ident, 'UU', ALL)
sym := SYM_UU
ELSEIF StrCmp(ident, 'PLAIN', ALL)
sym := SYM_PLAIN
ELSEIF StrCmp(ident, 'JCENTER', ALL)
sym := SYM_JCENTER
ELSEIF StrCmp(ident, 'JLEFT', ALL)
sym := SYM_JLEFT
ELSEIF StrCmp(ident, 'JRIGHT', ALL)
sym := SYM_JRIGHT
ELSEIF StrCmp(ident, 'DATABASE', ALL)
sym := SYM_DATABASE
ELSEIF StrCmp(ident, 'INDEX', ALL)
sym := SYM_INDEX
ELSEIF StrCmp(ident, 'REM', ALL)
sym := SYM_REM
ELSEIF StrCmp(ident, 'REMARK', ALL)
sym := SYM_REM
ELSEIF StrCmp(ident, 'TITLE', ALL)
sym := SYM_TITLE
ELSEIF StrCmp(ident, 'NODE', ALL)
sym := SYM_NODE
ELSEIF StrCmp(ident, 'MAIN', ALL)
sym := SYM_MAIN
ELSEIF StrCmp(ident, 'ENDNODE', ALL)
sym := SYM_ENDNODE
ELSEIF StrCmp(ident, 'LINK', ALL)
sym := SYM_LINK
ELSEIF StrCmp(ident, 'SYSTEM', ALL)
sym := SYM_SYSTEM
ELSEIF StrCmp(ident, 'TEXT', ALL)
sym := SYM_TEXT
ELSEIF StrCmp(ident, 'SHINE', ALL)
sym := SYM_SHINE
ELSEIF StrCmp(ident, 'SHADOW', ALL)
sym := SYM_SHADOW
ELSEIF StrCmp(ident, 'FILL', ALL)
sym := SYM_FILL
ELSEIF StrCmp(ident, 'FILLTEXT', ALL)
sym := SYM_FILLTEXT
ELSEIF StrCmp(ident, 'BACKGROUND', ALL)
sym := SYM_BACKGROUND
ELSEIF StrCmp(ident, 'HIGHLIGHT', ALL)
sym := SYM_HIGHLIGHT
ELSE -> může TO být název fontu
SetStr(ident, StrLen(ident))
RightStr(poms, ident, 5) -> vezmeme posledních 5 znaků z ident
WriteF('Ident = \s, poms = \s\n', ident, poms) -> jen DEBUG!
IF StrCmp(poms, '.FONT', ALL) -> byla-li to koncovka ".font"
sym := SYM_FONTNAME -> bylo to jméno fontu!
ELSE
sym := SYM_UNKNOWN -> jinak neznámý symbol
ENDIF
ENDIF
CASE "\n" -> konec řádky
getchar()
sym := SYM_EOLN
CASE 34 -> uvozovky = začátek řetězce (zkopíruje se řetězec bez uvozovek!)
getchar()
i := 0
WHILE (znak <> 34) AND (znak <> 10) AND (znak > 0) AND (i < MAXSTRING - 1)
textstring[i] := znak
getchar()
i++
ENDWHILE
textstring[i] := 0 -> ukončení řetězce
getchar()
sym := SYM_STRING
CASE "{" -> začátek tagu
getchar()
sym := SYM_BRAC
CASE "}" -> konec tagu
getchar()
sym := SYM_KET
CASE "0" TO "9" -> číselná konstanta (decimální)
num := 0
WHILE (znak >= "0" ) AND (znak <= "9") -> DEC
num := Mul(num ,10) + (znak - "0") -> funkce Mul() je 32-bitové násobení
getchar()
ENDWHILE
sym := SYM_CONST
CASE 0 -> konec souboru
sym := SYM_EOF
DEFAULT
getchar()
sym := SYM_UNKNOWN -> jinak neznámý symbol
ENDSELECT
ENDPROC
/**************************************************************************************************/
/*
FindEndTag()
- najde konec právě zpracovávaného tagu = LF (ASCII 10), EOF (ASCII 0) nebo "}"
- prohledávání zastaví na ukončovacím znaku (LF, EOF, "}")
*/
PROC findendtag()
WHILE (znak <> 10) AND (znak > 0) AND (znak <> "}")
getchar()
ENDWHILE
ENDPROC
/*
FindEOLN()
- najde konec aktuální řádky = LF (ASCII 10) nebo EOF (ASCII 0)
- prohledávání zastaví na ukončovacím znaku (LF, EOF)
*/
PROC findeoln()
WHILE (znak <> 10) AND (znak > 0) -> najdi konec řádky
getchar()
ENDWHILE
ENDPROC
/**************************************************************************************************/
/*
EvalTags()
- může být volána jen po znaku @!
- volá getsym() a podle vracených symbolů kontroluje syntaxi a provádí příslušné akce.
- svoji práci končí na ukončovacím znaku (LF, EOF, "}") nebo na znaku následujícím.
- je to jen nástin jak by to mohlo vypadat...
*/
PROC evaltags()
SELECT sym
CASE SYM_BRAC -> tagy v závorkách ("{")
WriteF('@{... tags.\n')
getsym()
SELECT sym
CASE SYM_BG -> nastavení barvy pozadí - tag @{BG <colour name>}
WriteF('@{BG...}\n') -> DEBUG!
getsym()
IF (sym >= SYM_TEXT) AND (sym <= SYM_HIGHLIGHT)
WriteF('@{BG <c>} - OK\n') -> DEBUG!
-> nastavit barvu pozadí na <c> = sym - SYM_TEXT
findendtag()
ELSEIF sym := SYM_KET
WriteF('@{BG chybi barva} - ERR\n') -> DEBUG!
-> nastavit barvu pozadí na 0 (= Background)
ELSE
WriteF('@{BG nespravna barva} - ERR\n') -> DEBUG!
-> nastavit barvu pozadí na 0 (= Background)
findendtag()
ENDIF
CASE SYM_FG -> nastavení barvy textu - tag @{FG <colour name>}
WriteF('@{FG...}\n') -> DEBUG!
getsym()
IF (sym >= SYM_TEXT) AND (sym <= SYM_HIGHLIGHT)
WriteF('@{FG <c>} - OK\n') -> DEBUG!
-> nastavit barvu textu na <c> = sym - SYM_TEXT
findendtag()
ELSEIF sym := SYM_KET
WriteF('@{FG chybi barva} - ERR\n') -> DEBUG!
-> nastavit barvu textu na 1 (= Text)
ELSE
WriteF('@{FG spatna barva} - ERR\n') -> DEBUG!
-> nastavit barvu textu na 1 (= Text)
findendtag()
ENDIF
CASE SYM_APEN -> - tag @{APEN <n>}
WriteF('@{APEN...}\n') -> DEBUG!
getsym()
IF sym = SYM_CONST
WriteF('@{APEN <n>} - OK\n') -> DEBUG!
-> nastavit barvu textu na num
findendtag()
ELSEIF sym := SYM_KET
WriteF('@{APEN chybi barva} - ERR\n') -> DEBUG!
-> nastavit barvu textu na 1 (= Text)
ELSE
WriteF('@{APEN spatne cislo barvy} - ERR\n') -> DEBUG!
-> nastavit barvu textu na 1 (=Text)
findendtag()
ENDIF
CASE SYM_BPEN -> - tag @{BPEN <n>}
WriteF('@{BPEN...}\n') -> DEBUG!
getsym()
IF sym = SYM_CONST
WriteF('@{BPEN <n>} - OK\n') -> DEBUG!
-> nastavit barvu pozadí na num
findendtag()
ELSEIF sym := SYM_KET
WriteF('@{BPEN chybi cislo barvy} - ERR\n') -> DEBUG!
-> nastavit barvu pozadí na 0 (= Back)
ELSE
WriteF('@{BPEN spatne cislo barvy} - ERR\n') -> DEBUG!
-> nastavit barvu pozadí na 0 (=Back)
findendtag()
ENDIF
CASE SYM_B -> bold - tag @{B}
WriteF('@{B} - OK\n') -> DEBUG!
-> nastavit styl textu na BOLD
findendtag()
CASE SYM_UB -> zruš bold - tag @{UB}
WriteF('@{UB} - OK\n') -> DEBUG!
-> zrušit styl textu BOLD
findendtag()
CASE SYM_I -> kurzíva - tag @{I}
WriteF('@{I} - OK\n') -> DEBUG!
-> nastavit styl textu na ITALIC
findendtag()
CASE SYM_UI -> zruš kurzívu - tag @{UI}
WriteF('@{UI} - OK\n') -> DEBUG!
-> zrušit styl textu ITALIC
findendtag()
CASE SYM_U -> underlined - tag @{U}
WriteF('@{U} - OK\n') -> DEBUG!
-> nastavit styl textu na UNDERLINED
findendtag()
CASE SYM_UU -> zruš U - tag @{UU}
WriteF('@{UU} - OK\n') -> DEBUG!
-> zrušit styl textu UNDERLINED
findendtag()
CASE SYM_PLAIN -> zruš styly -> tag @{PLAIN}
WriteF('@{PLAIN} - OK\n') -> DEBUG!
-> nastavit styl textu na základní (= UB, UI, UU)
findendtag()
CASE SYM_JCENTER -> centrování - tag @{JCENTER}
WriteF('@{JCENTER} - OK\n') -> DEBUG!
-> nastavit centrování řádky
findendtag()
CASE SYM_JLEFT -> doleva - tag @{JLEFT}
WriteF('@{JLEFT} - OK\n') -> DEBUG!
-> nastavit zarovnání řádky doleva
findendtag()
CASE SYM_JRIGHT -> doprava - tag @{JRIGHT}
WriteF('@{JRIGHT} - OK\n') -> DEBUG!
-> nastavit zarovnání řádky doprava
findendtag()
CASE SYM_STRING -> tag @{<linkname> LINK <nodename> [<linenum>]}
-> uložení jména linku (text tlačítka) z textstring[]
getsym()
IF sym = SYM_LINK -> je TO normální link
getsym()
IF sym = SYM_STRING -> nodename
-> uložení jména cílového nodu (cíl skoku) z textstring[]
getsym()
IF sym = SYM_CONST -> číslo řádky, na kterou se má skočit
-> zobrazení jména linku
-> zapsání linku DO struktur (kok na řádku num)
findendtag()
ELSEIF sym = SYM_KET
-> zobrazení jména linku
-> zapsání linku DO struktur (skok na řádku 0)
ELSE
-> ignoruj link
findendtag()
ENDIF
ELSEIF sym = SYM_KET -> jsme na konci tagu + 1 znak!
ELSE
findendtag()
ENDIF
ELSEIF sym = SYM_SYSTEM
getsym()
IF sym = SYM_STRING -> command
-> zobrazení jména linku
-> zapsání linku DO struktur (kok na řádku num, spracování = execute())
findendtag()
ELSEIF sym = SYM_KET -> jinak ignoruj link
ELSE
findendtag()
ENDIF
ELSEIF sym = SYM_KET
ELSE
findendtag()
ENDIF
DEFAULT
WriteF('@{? - Unknown node! - ERR\n') -> DEBUG!
findendtag()
ENDSELECT -> konec příkazů @{...
CASE SYM_DATABASE -> tag @DATABASE [<database name>]
WriteF('@DATABASE ...\n') -> DEBUG!
getsym()
IF sym = SYM_STRING
WriteF('@DATABASE <string> - OK\n') -> DEBUG!
-> nastav jméno textu na textstring[]
findeoln()
ELSE
WriteF('@DATABASE nostring - ERR\n') -> DEBUG!
findeoln()
ENDIF
CASE SYM_REM -> tag @REM ... nebo @REMARK ...
WriteF('@REM text - OK\n') -> DEBUG!
findeoln()
CASE SYM_TITLE -> tag @TITLE <titlename>
WriteF('@TITLE ...\n') -> DEBUG!
getsym()
IF sym = SYM_STRING
WriteF('@TITLE <string> - OK\n') -> DEBUG!
-> nastav titul textu na textstring[]
findeoln()
ELSE
WriteF('@TITLE nostring - ERR\n') -> DEBUG!
findeoln()
ENDIF
CASE SYM_FONT -> tag @FONT <fontname> <size>
WriteF('@FONT ...\n') -> DEBUG!
getsym()
IF sym = SYM_FONTNAME
WriteF('@FONT <fontname> ... \n') -> DEBUG!
getsym()
IF sym = SYM_CONST
WriteF('@FONT <fontname> <size> - OK\n') -> DEBUG!
-> nastav font na ident[] a velikost num
findeoln()
ELSE
WriteF('@FONT <fontname> - OK\n') -> DEBUG!
-> nastav font na ident[] a velikost 8 (= základní)
findeoln()
ENDIF
ELSE
WriteF('@FONT nofontname - ERR \n') -> DEBUG!
-> nastav font na základní a velikost 8 (= základní)
findeoln()
ENDIF
CASE SYM_NODE -> tag @NODE <nodename> [<nodetitle>]
WriteF('@NODE ...\n') -> DEBUG!
getsym()
IF sym = SYM_STRING
WriteF('@NODE <nodename> ... \n') -> DEBUG!
-> ulož jméno nodu z textstring
getsym()
IF sym = SYM_STRING
WriteF('@NODE <nodename> <nodetitle> - OK\n') -> DEBUG!
-> ulož titul nodu z textstring
-> nastav hledání @ENDNODE (a ukonči předchozí node, pokud platilo hledání @ENDNODE)
-> zapiš začátek nodu DO struktur
findeoln()
ELSE
WriteF('@NODE <nodename> - OK\n') -> DEBUG!
-> zapiš začátek nodu DO struktur
-> nastav hledání @ENDNODE (a ukonči předchozí node, pokud platilo hledání @ENDNODE)
findeoln()
ENDIF
ELSEIF sym = SYM_MAIN
WriteF('@NODE MAIN ...\n') -> DEBUG!
getsym()
IF sym = SYM_STRING
WriteF('@NODE MAIN <nodetitle> - OK\n') -> DEBUG!
-> ulož titul nodu z textstring
-> nastav hledání @ENDNODE (a ukonči předchozí node, pokud platilo hledání @ENDNODE)
-> zapiš začátek nodu DO struktur jako MAIN
findeoln()
ELSE
WriteF('@NODE MAIN - OK\n') -> DEBUG!
-> zapiš začátek nodu DO struktur jako MAIN
-> nastav hledání @ENDNODE (a ukonči předchozí node, pokud platilo hledání @ENDNODE)
findeoln()
ENDIF
ELSE
WriteF('@NODE nonodename - ERR \n') -> DEBUG!
-> ignoruj nepojmenovaný node
findeoln()
ENDIF
CASE SYM_ENDNODE -> tag @ENDNODE
WriteF('@ENDNODE - OK\n') -> DEBUG!
-> zapiš konec nodu DO struktur
-> zruš hledání @ENDNODE
-> nastav hledání @NODE ...
findeoln()
CASE SYM_INDEX -> tag @INDEX <nodename>
WriteF('@INDEX ...\n') -> DEBUG!
getsym()
IF sym = SYM_STRING
WriteF('@INDEX <nodename> - OK\n') -> DEBUG!
-> zapiš jméno nodu, který má být indexem, DO struktur
findeoln()
ELSE
WriteF('@INDEX nostring - ERR\n') -> DEBUG!
findeoln()
ENDIF
DEFAULT
WriteF('@? - Unknown node! - ERR\n') -> DEBUG!
findeoln()
ENDSELECT
ENDPROC
/** END ********************************************************************************************/
PS. Komerční využití zdrojáku povoluji, ale za 200% podíl na zisku. Ha, ha!
Další ve frontě:
|
|
|
|
|
|
|
|
| Vokecávky |
Hardware | Warez | WBoviny | Dema |
Gfx&Muz | Pařby | Vokecávky 2 |
