flat assembler
Message board for the users of flat assembler.

flat assembler > Macroinstructions > Ultimate High-Level Features

Author
Thread Post new topic Reply to topic
uart777



Joined: 17 Jan 2012
Posts: 369
Hi. I would like to present a collection of my latest HL features reduced to one file: LANGUAGE.INC.

Code:
; $$$$$$$$$$$$$$ Z77 ASM LIBRARY $$$$$$$$$$$$$$$$$
; ************** SUNGOD SOFTWARE *****************
; ??????????????? LANGUAGE.INC ???????????????????

; $$$$$$$$$$ EVOLUTION OF HL ASM SYNTAX $$$$$$$$$$

;;;;;;;;;;;;;;;;; VARIABLE.INC ;;;;;;;;;;;;;;;;;;;

; define variable of type

macro !DV type, name, value {
local l
l=$
name type value ; example: msg db 'Hello'
name#.$=$-l     ; size
}

; define b/w/d/q/t variables

macro !D1 name, value { !DV db, name, value }
macro !D2 name, value { !DV dw, name, value }
macro !D4 name, value { !DV dd, name, value }
macro !D8 name, value { !DV dq, name, value }
macro !DF name, value { !DV dt, name, value }

; display error if no match

macro verify.syntax name {
if ?s eq 0
 'Invalid syntax: ' name
end if
}

; verify size of block/text/array

macro verify.size n {
if n eq
 'Size must be specified'
else if ~ n eqtype 0
 'Size must be numeric'
else if n eq 0
 'Size cannot be zero'
end if
}

; define byte array. BLOCK b(size)

macro BLOCK [p] {
forward
define ?s 0
match =0 name(size), ?s p \{
 verify.size size
 !DV db, name, size dup(0)
 define ?s 1
\}
verify.syntax BLOCK
}

macro TEXTA name, [t] {
?nta=0
common
label name dword
forward local l
dd l
?nta=?nta+1
forward l db t, 0
name#.$=?nta
}

; create HL 'text' variable/s. TEXT t='X'.
; note: (n) is the size

macro TEXT [p] {
forward
local l
define ?s 0
; TEXT t(n)='abc'
match =0 name(size)==text, ?s p \{
 l=$
 verify.size size
 !DV db, name, <text,0>
 times (size-($-l)) db 0
 define ?s 1
\}
; TEXT t(n)
match =0 name(size), ?s p \{
 verify.size size
 !DV db, name, size dup(0)
 name\#.$=size
 define ?s 1
\}
; TEXT t='abc'
match =0 name==text, ?s p \{
 !DV db, name, <text,0> ; name db 't', 0
 define ?s 1
\}
; TEXT t
match =0 name, ?s p \{
 'Size must be specified:' name
 define ?s 1
\}
verify.syntax TEXT
}

;;;;;;;;;;;;;; DEFINE HL VARIABLE ;;;;;;;;;;;;;;;;

; define X. syntax: type then any a/a=b
; sequence/s separated with ,s. example:
; NUMBER x, y, w=320, h=240
; variables=0 if there is no initial value

macro !D type, [p] {
common
if p eq
 'Name expected'
end if
forward
define ?s 0
match =0 a==b, ?s p \{ ; a=b
 type a, b
 define ?s 1
\}
match =0 a=,, ?s p \{  ; a, (next)
 type a, 0
 define ?s 1
\}
match =0 a, ?s p \{    ; a (end)
 type a, 0
 define ?s 1
\}
verify.syntax variable
}

; HL variable names

macro BYTE [a]   { !D !D1, a }
macro WBYTE [a]  { !D !D2, a }
macro NUMBER [a] { !D !D4, a }
macro NUMERO [a] { !D !D8, a }
macro REAL [a]   { !D !D4, a }
macro REAL8 [a]  { !D !D8, a }
macro REAL10 [a] { !D !DF, a }

macro VOID [a]   {
if USE=32
 !D !D4, a
else
 !D !D8, a
end if
}

NUMBER.P fix VOID
TEXT.P   fix VOID
IMAGE.P  fix VOID

WORD     fix WBYTE
DWORD    fix NUMBER
BOOLEAN  fix NUMBER
HANDLE   fix VOID

;;;;;;;;;;;;;; NUMERIC CONSTANTS ;;;;;;;;;;;;;;;;;

; create a list of incremental values starting
; at 0. example: numeric A, B=7, D
; here, A=0, D=8

macro numeric [id] {
common
local n
n=0                ; n=0
forward
define ?v 0        ; initial value?
match a==b, id \{
 a=b
 n=b               ; set n
 define ?v 1
\}
if ?v=0            ; else=n (previous+1)
id=n
end if
n=n+1              ; n++
}

numeric YES=1, NO=0, NONE=-1, MAYBE=80h,\
TRUE=1, FALSE=0, NULL=0, DEFAULT=0,\
INVALID=-1, INFINITE=-1, DETECT=-1

; "enumeration" with variable

macro numerate v, [id] {
common NUMBER v
numeric id
}

; create successive powers of 2 starting
; at BIT0, from right to left

macro powers [id] {
common idn=0
forward id=1 shl idn
idn=idn+1
}

; create readable bit structure from
; left to right. example: 0000ABCDb.
; powerz A, B, C, D ; A=8, B=4, C=2, D=1

macro powerz [id] {
common idn=1
forward idn=idn+1
common idn=idn-2
forward id=1 shl idn
idn=idn-1
}

;;;;;;;;;;;;;;;; LITERAL 'TEXT' ;;;;;;;;;;;;;;;;

; create array of literal 'text' addresses
; example: TEXTA colors, 'Black', 'White'
; access: let ecx=[index], eax=[colors+ecx*4]

macro TEXTA name, [t] {
?nta=0
common
label name dword
forward local l
dd l
?nta=?nta+1
forward l db t, 0
name#.$=?nta
}

; same but align each to size

macro TEXTAA name, size, [t] {
common
?nta=0
label name dword
forward
local l
dd l
?nta=?nta+1
forward
l db t, 0
times (size-($-l)) db 0 ; align
common
name#.$=?nta
}

; HL TEXT array syntax...

; TEXTS t[]='abc', 'xyz', '123'
; TEXTS t[](4)='ann', 'kim', 'sue'

macro TEXTS [p] {
common
define ?s 0
match name[](size)==t, p \{
 TEXTAA name, size, t
 define ?s 1
\}
match =0 name[]==t, ?s p \{
 TEXTA name, t
 define ?s 1
\}
verify.syntax TEXTS
}

; same as TEXTA but with ids. example:

; MESSAGES error.messages,\
; E_NONE='None',\
; E_MEMORY='Insufficient Memory',\
; E_LOAD='Error Loading File',\
; E_VGA='Unsupported Resolution',\
; E_ETC='Etc'

macro MESSAGES name, [p] {
common ?n=0
label name dword
forward
local l
dd l
forward
match a==b, p \{
 l db b, 0
 a=?n
 ?n=?n+1
\}
common
name#.$=?n
}

macro MESSAGEZ name, i, prefix, [p] {
common
NUMBER i
?n=0
label name dword
forward
local l
dd l
forward
match a==b, p \{
 l db b, 0
 prefix\#_\#a=?n
 ?n=?n+1
\}
common
name#.$=?n
numeric prefix#_#LAST=?n
}

; create 'text' in code. r/egister='t/ext'
; WARNING: all commands that accept a literal
; 'text' parameter (.t suffix) will alter eax.
; only intended for testing and utilities

macro make.txt r, t {
if t eqtype ""
 local ..t, ..e
 jmp ..e
 ..t db t, 0
 ..e:
 mov r, ..t
else
 mov r, t
end if
}

;;;;;;;;;;;;;;;;;;;;; LET ;;;;;;;;;;;;;;;;;;;;;;;;

; perform HL assignment/s/operation/s. example:

; let esi=[source], ecx>>8, eax=&[esi+ecx*4]

; signed is the default for numbers that can
; be negative (ex, coordinates). some symbols
; are for unsigned operations (>>> is shr)

; WARNING: +/- [b+/-i] sequence will not be
; interpreted correctly. both ++/--/+-/-+ cannot
; used. replace let eax+[?image.x+edx] (has 2 ++)
; with: let ecx=[?image.x+edx], eax+ecx

macro let [p] {
forward
define ?s 0

; a=&[b], lea r, [b]

match =0 a==&b, ?s p \{
 lea a, b
 define ?s 1
\}

; a=>[b], movsx r, byte [b]

match =0 a==>b, ?s p \{
 movsx a, byte b
 define ?s 1
\}

; a=b, mov or push/pop or xor

match =0 a==b, ?s p \{
 if a eqtype [] & b eqtype [] ; m=m
  push dword b
  pop dword a
 else
  if b eq 0 & \
   a in <eax,ecx,edx,ebx,esi,edi>
    xor a, a
  else
   mov a, b
  end if
 end if
 define ?s 1
\}

; increment/decrement

match =0 a--, ?s p \{
 dec a
 define ?s 1
\}

match =0 a++, ?s p \{
 inc a
 define ?s 1
\}

; add/subtract

match =0 a-b, ?s p \{
 if b eq 1
  dec a
 else
  sub a, b
 end if
 define ?s 1
\}

match =0 a+b, ?s p \{
 if b eq 1
  inc a
 else
  add a, b
 end if
 define ?s 1
\}

; multiply/divide

match =0 a*b, ?s p \{
imul a, b
define ?s 1
\}

; for idiv, only eax/n is allowed
; n must be m/ecx, not i. alters edx
; example: eax=n/123 may be written
; as - let eax=n, ecx=123, eax/ecx -
; instead of 4 separate lines

match =0 =eax/n, ?s p \{
cdq
idiv n
define ?s 1
\}

; shifts

match =0 a>>>b, ?s p \{ shr a, b
define ?s 1 \}
match =0 a<<b, ?s p \{ sal a, b
define ?s 1 \}
match =0 a>>b, ?s p \{ sar a, b
define ?s 1 \}

; binary and/or

match =0 a&b, ?s p \{ and a, b
define ?s 1 \}
match =0 a|b, ?s p \{ or a, b
define ?s 1 \}

; neg/not unary prefixes

match =0 =neg a, ?s p \{
 neg a
 define ?s 1
\}

match =0 =not a, ?s p \{
 not a
 define ?s 1
\}

verify.syntax .let
}

; set/end hl block

macro set.hl.block c { HL.BLOCK=c }

macro end.hl.block c {
if HL.BLOCK=c
  HL.BLOCK=0
else
 'end/x unexpected'
end if
}

numeric IF.BLOCK, ELSE.BLOCK,\
LOOP.BLOCK

macro ?list.attach list, item {
match any, list \{ list equ list, item \}
match , list \{ list equ item \}
}

;;;;;;;;;;;;;;; FASM'S STRUCT.INC ;;;;;;;;;;;;;;;;

; an edited version of \MACRO\STRUCT.INC designed
; for Z77 HL variables

; NOTE: VARIABLE.INC>BLOCK can define/reserve
; any byte array so it replaces rb/rw/etc

macro struct name {
virtual at 0
fields@struct equ name
match child parent, name \{
fields@struct equ child,fields@\#parent \}
sub@struct equ
macro define.field.member type \{
struc type [val] \\{ \\common
define field@struct .,type,<val>
fields@struct equ fields@struct,field@struct \\}
\}
macro define.field.macro type \{
macro type [val] \\{ \\common \\local anonymous
define field@struct anonymous,type,<val>
fields@struct equ fields@struct,field@struct \\}
\}
define.field.member db
define.field.member dw
define.field.member dd
define.field.macro db
define.field.macro dw
define.field.macro dd
macro struct \{
fields@struct equ fields@struct,,substruct,<
sub@struct equ substruct
\}
}

macro ends {
match , sub@struct \{
restruc db,dw,dd
purge db,dw,dd
purge struct
match name tail,fields@struct, \\{
 if $
  'Error: Invalid member'
 end if
\\}
match name=,fields,fields@struct \\{
fields@struct equ
make@struct name,fields
define fields@\\#name fields \\}
end virtual \}
match any, sub@struct \{
fields@struct equ fields@struct> \}
restore sub@struct
}

macro make@struct name,[field,type,def] {
common
local define
define equ name
forward
local sub
match , field \{
make@substruct type,name,sub def
define equ define,.,sub, \}
match any, field \{
define equ define,.#field,type,<def> \}
common
match fields, define \{ define@struct fields \}
}

macro define@struct name,[field,type,def] {
common
local list
list equ
forward
if ~ field eq .
name#field type def
sizeof.#name#field=$-name#field
else
label name#.#type
rb sizeof.#type
end if
local value
match any, list \{ list equ list, \}
list equ list <value>
common
sizeof.#name = $
restruc name
match values, list \{
struc name value \\{ \\local \\..base
match any, fields@struct \\\{
fields@struct equ fields@struct,.,name,<values> \\\}
match , fields@struct \\\{ label \\..base
forward
match , value \\\\{ field type def \\\\}
match any, value \\\\{ field type value
if ~ field eq .
 rb sizeof.#name#field - ($-field)
end if \\\\}
common label . at \\..base \\\}
\\}
macro name value \\{
match any, fields@struct \\\{ \\\local anonymous
fields@struct equ fields@struct,anonymous,name,<values> \\\}
match , fields@struct \\\{
forward
match , value \\\\{ type def \\\\}
match any, value \\\\{ \\\\local ..field
..field = $
type value
if ~ field eq .
 rb sizeof.#name#field - ($-..field)
end if \\\\}
common \\\} \\} \}
}

macro enable@substruct {
macro make@substruct substruct,\
parent,name,[field,type,def] \{
\common
\local define
define equ parent,name
\forward
\local sub
match , field \\{ match any, type \\\{ enable@substruct
make@substruct type,parent,sub def
purge make@substruct
define equ define,.,sub, \\\} \\}
 match any, field \\{ define equ define,.\#field,type,<def> \\}
\common
 match fields, define \\{ define@\#substruct fields \\} \}
}

enable@substruct

macro define@substruct parent,name,[field,type,def] {
common
virtual at parent#.#name
forward
if ~ field eq .
parent#field type def
sizeof.#parent#field = $ - parent#field
else
label parent#.#type
rb sizeof.#type
end if
common
sizeof.#name = $ - parent#.#name
end virtual
struc name value \{
label .\#name
forward
match , value \\{ field type def \\}
match any, value \\{ field type value
if ~ field eq .
 rb sizeof.#parent#field - ($-field)
end if \\}
common \}
macro name value \{
\local ..anonymous
..anonymous name \}
}

; $$$$$$$$$$$$$$ Z77 ASM LIBRARY $$$$$$$$$$$$$$$$$
; ************** SUNGOD SOFTWARE *****************
; ??????????????? STRUCTURE.INC ??????????????????

macro STRUCTURE type {
?TYPE equ type
struct _#type
macro type [names] \{  ; IMAGE a, b, c
 forward
 names _\#type
 common
\}
type#.$=sizeof._#type
}

macro TYPE [p] {                      
common
match name==members, p \{
 STRUCTURE name
  members
 ends
\}                                    
}

macro INHERIT [s] { forward s#.X }

macro ASSUME [p] {
match name==type, p \{                
 virtual at 0
  type name
 end virtual
\}                                    
}

macro ENDS name {
ends
if ~p eq
 ASSUME name=?TYPE
end if
}

structure fix STRUCTURE ; optional

; $$$$$$$$$$$$$$ Z77 ASM LIBRARY $$$$$$$$$$$$$$$$$
; ************** SUNGOD SOFTWARE *****************
; ??????????????? FUNCTION.INC ???????????????????

; push parameters forwards or backwards

macro pushf [p] { ; push parameters forward
common if ~p eq
forward pushd p
common end if
}

macro pushr [p] { ; push parameters backwards
common            ; to access forwards
if ~p eq
 reverse
 if p eq
  'Invalid # of parameter/s'
 end if
 pushd p
common
end if
}

; call a/ddress direct or p/ointer indirect

macro calla a, [p] {
common pushr p
call a
}

macro callp c, [p] { common calla [c], p }

; call "variadic" procedure with "variable
; arguments" (...). push invisible # arguments
; last, call, then adjust esp after

macro callv c, [p] {
common ?n=0
reverse pushd p
?n=?n+1
common push ?n
call c
add esp, (?n+1)*4
}

; call "interface"

macro callx c, x, [p] {
common
pushr p            ; push parameters
mov eax, [c]
push eax           ; push class address
mov eax, [eax]
call dword [eax+x] ; call c+m
}

; call function pointer if non-zero

macro callfp f {
cmp dword [f], 0
jz @f
calla dword [f]
@@:
}

; call function if defined

macro ?call name, [p] {
common
if defined name
 calla name, p
end if
}

; call function then get return. example:

; get [n]=text.n [t]
; get [c]=rgb 128, 0, 64

macro get [p] {
common
define ?s 0
match v==f, p \{
 f
 mov v, eax
 define ?s 1
\}
match =0 v==f ps, ?s p \{
 f ps
 mov v, eax
\}
}

; call function then jmp to return
; if it returns 0. example:

; try open my.file
; try [p]=allocate 4*KB

macro try [p] {
common
define ?s 0
match a==b, p \{
 b
 mov a, eax
 define ?s 1
\}
if ?s eq 0
 common p
end if
fail .! ; endf
}

;;;;;;;;;;;;;; FUNCTION/PROCEDURE ;;;;;;;;;;;;;;;

macro DEBUG { ?DEBUG?: }
macro if.debug { if defined ?DEBUG? }

; create "function/proc/edure"

macro function name, [p] {
common

; if debug, insert function name to view
; as a "string" in PE Explorer

if.debug
@@: db `name, 0
end if

; only insert this inside of the executable
; if it was accessed somewhere

if used !#name
!#name: ; real function !name

; macro to call with no prefix: calla,
; "stdcall". example: f a, b, c

macro name p \{
pushr p
call !#name
\}

!#name.$type='c'
?begin equ !#name
?parameters equ p
..n.parameters=0
..n.locals=0
..locals.size=0

; create parameter names and offsets

if ~ p eq          ; if parameters
 virtual at ebp+8
 forward
 local ..p
 ..p dd ?          ; (ebp+Cool+i*4
 p equ ..p
 ..n.parameters=\
 ..n.parameters+1
 common
 end virtual
 push ebp          ; create stack frame
 mov ebp, esp
end if
; ...
}

; HL return statement. use this instead of
; ret/n in HL commands. no ret/urn before endf.
; it inserts one automatically

macro return v {
if ~v eq               ; value?
 mov eax, v
end if
if ..n.parameters<>0   ; if parameters
 mov esp, ebp
 pop ebp
 ret ..n.parameters*4 ; ret n
else if ..n.locals<>0  ; if locals
 mov esp, ebp
 pop ebp
 ret
else
 ret
end if
}

; exit function; an effecient "return"
; that jmps to endf without repeating
; epilogue sequence (use this if there
; are locals/parameters and registers
; to preserve)

macro escape v {
if ~v eq         ; value?
 mov eax, v
end if
jmp .!
}

; end function

macro endf {
.!:
return
.$=$-?begin               ; total size
if ..n.parameters<>0      ; if parameters
 match p, ?parameters
 \{ restore p, ?begin \}
end if
if ..n.locals<>0          ; if locals
 match l, local.names
 \{ restore l \}
end if

; end "if used name" at very beginning
; of function

end if
}

; locals ... - create local 32BIT variables.
; example: locals x, y, n, c

macro locals [p] {
common local.names equ p
forward ..n.locals=..n.locals+1
common ..locals.size=..n.locals*4
virtual at ebp-..locals.size
forward
local ..l
..l dd ?
p equ ..l
common
end virtual
if ..n.parameters=0    ; create stack frame?
 push ebp
 mov ebp, esp
end if
sub esp, ..locals.size ; allocate locals
}

;;;;;;;;;;;;;;;;;; TESTING... ;;;;;;;;;;;;;;;;;;;;

; create locals of specified sizes or 32BIT.
; example:

; locale x, y, username(32), filename(256),\
; image(IMAGE.$), etc

macro locale [p] {
common
..locals.size=0
forward                ; get names and sizes
define ?s 0
match name(size), p \{ ; size specified
 ?list.attach local.names, name
 verify.size size
 ..locals.size=..locals.size+size
 define ?s 1
\}
match =0 name, ?s p \{  ; default 32BIT
 ?list.attach local.names, name
 ..locals.size=..locals.size+4
 define ?s 1
\}
..n.locals=..n.locals+1
common
virtual at ebp-..locals.size ; get offsets
forward
local ..l
define ?s 0
match name(size), p \{
 ..l dd (size/4) dup(?)
 name equ ..l
 define ?s 1
\}
match =0 name, ?s p \{ ; default 32BIT
 ..l dd ?
 name equ ..l
 define ?s 1
\}
common
end virtual
if ..n.parameters=0    ; create stack frame?
 push ebp
 mov ebp, esp
end if
sub esp, ..locals.size ; allocate locals
}

; create locals of size

macro localss size, [p] {
common local.names equ p
if ..n.parameters=0 \
 & ..n.locals=0
 push ebp
 mov ebp, esp
end if
forward ..n.locals=..n.locals+1
common ..locals.size=..n.locals*size
virtual at ebp-..locals.size
forward
local ..l
..l: db size dup(0)
p equ ..l
common
end virtual
sub esp, ..locals.size
}

macro localt [p] { common localss 1*KB, p }
macro localst [p] { common localss 256, p }

; load structure members to locals of the
; same name. example:
; get.s eax, ?box, box, x, y, w, h -
; loads box.x/y/w/h to local x/y/w/h using eax
; as a base register and it produces 4 lines
; (# parameters in [v])

macro get.s r, vs, s, [v] {
common let r=[s]
forward let [v]=[vs#.#v+r]
}

; $$$$$$$$$$$$$$$ Z77 ASM LIBRARY $$$$$$$$$$$$$$$$
; *************** SUNGOD SOFTWARE ****************
; ??????????????????? IF.INC ?????????????????????

true equ eax
false equ not eax
result equ eax
?NOT equ 0
?use.r equ 0

; jump if condition to l (or ?NOT if 1)

macro .jif l, [c] {
common
local s
define s 0
macro J O,A,C,B, [X] \{
match =0 X, s c \\{
 if ?use.r eq 0
  O A, B        ; opcode o1, o2
 else
  mov ?use.r, A
  O ?use.r, B
 end if
 if ?NOT eq 0
  j\#C l
 else
  jN\#C l
 end if
 define s 1
\\}
\}
J cmp,a,LE,b, a<==b    ; a<=b
J cmp,a,GE,b, a>==b    ; a>=b
J cmp,a,L,b, a<b       ; a<b
J cmp,a,G,b, a>b       ; a>b
J cmp,a,E,b, a==b      ; a=b
J cmp,a,NE,b, a =not b ; a not b (unequal)
J test,a,NE,b, a&b     ; a&b
J or,a,NE,b, a|b       ; a|b
J cmp,a,E,0, =not a    ; not a (=0)
J cmp,a,NE,0, a        ; a (not 0)
if s eq 0
 'Invalid expression'
end if
purge J
?use.r equ 0           ; only once
}

; jump if NOT condition to l

macro .jifn l, [c] {
common
?NOT equ 1
.jif l, c
?NOT equ 0 ; restore default
}

; HL IF/ELSE

macro .if.begin {
local ..start, ..else, ..end
?IF equ
?START equ ..start
?ELSE equ ..else
?END equ ..end
?START:
}

macro .if [c] {
common
.if.begin
.jifn ?ELSE, c ; if false, jmp to end
}

macro .if.n [c] {
common
.if.begin
.jif ?ELSE, c
}

macro .else {
jmp ?END
?ELSE:
restore ?IF
?IF equ ,
}

macro .else.if [c] {
common
jmp ?END
?ELSE:
restore ?ELSE
local ..else
?ELSE equ ..else
.jifn ?ELSE, c
}

macro .end {
if ?IF eq
 ?ELSE:
end if
?END:
restore ?IF, ?START, ?ELSE, ?END
}

; call function with parameters then
; .if non/zero

macro !if c, [p] {
common c p
.if eax
}

macro !if.n c, [p] {
common c p
.if not eax
}

jNE equ jne
jNNE equ je
jNG equ jng
jNL equ jnl

macro jif r, c, l {
test r, r
j#c l
}

macro success l { jif eax, nz, l }

macro fail l { jif eax, z, l }

macro failn l {
cmp eax, -1
je .r
}

failnz fix success

; $$$$$$$$$$$$$$$ Z77 ASM LIBRARY $$$$$$$$$$$$$$$$
; *************** SUNGOD SOFTWARE ****************
; ?????????????????? LOOP.INC ????????????????????

; .while a<b
; .endw

; .until a=b
; .endu

; .loop i=x to n
; .endl

; .for i=n, i>0, i-- ; assign, compare, operate
; .endf

; WARNING: .loop/.for alters ECX on entry/exit to
; support cmp memory operands. .while/.until do
; not alter any registers

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

macro .while [c] {
common
local ..next, ..out
?NEXT equ ..next
?OUT equ ..out
.if c
  ; ...
}

macro .endw {
  ?NEXT:
  jmp ?START
.end
?OUT:
restore ?NEXT, ?OUT
}

macro .until [c] {
common
?NOT equ 1
.while c
?NOT equ 0
}

.endu fix .endw

; .for let a, .while b, let c

macro .for [p] {
common
local ..nextf
?NEXT equ ..nextf
?FOR equ
define ?s 0

match a=,b=,c, p \{
let a
?use.r equ ecx
.while b            ; {
  ?FOR equ c
  define ?s 1
\}
verify.syntax .for
}

macro .endf {
  let ?FOR
.endw               ; }
}

; .loop [i]=0 to [n]

macro .loop [c] {
common
local ..start, ..end
?START equ ..start
?END equ ..end
define ?s 0
match =0 i==x =to n, ?s c \{
 define ?s 1
 ?INDEX equ i
 push x
 pop i
 ?START:
 mov ecx, i
 cmp ecx, n
 jge ?END
\}
verify.syntax .loop
}

macro .endl {
inc ?INDEX    ; i++
jmp ?START    ; continue
?END:
restore ?START, ?END, ?INDEX
}

; optional let operator . nothing else
; can be named .

. fix let
    


This file contains unique ideas that may be useful to programmers who write their own HL macros: variable declarations, assignments, operations, arrays, structures, functions, loops, etc.

Any suggestions, variations or improvements? Any HL macros to contribute? We can exchange ideas and develop our own custom HL syntaxes to increase productivity and make it easier to create real-life applications in FASM.

Example Files

IMPORT.INC (How to remove invoke prefix)

Code:
; $$$$$$$$$$$$$$ Z77 ASM LIBRARY $$$$$$$$$$$$$$$$$
; ************** SUNGOD SOFTWARE *****************
; ????????????????? IMPORT.INC ???????????????????

; RVAs of dll names and tables, ending with 20
; zero bytes

macro library [names] {
forward dd 0,0,0, RVA names#_name, RVA names#_table
common dd 0,0,0,0,0
}

; DLL name + import RVA table. each table ends with 0.
; finally, import names. dw 0 is "ordinal" (N/A)

macro import name, [names] {
common
name#_name \            ; TEXT DLL_name='DLL.DLL'
db `name#'.DLL', 0
name#_table:            ; DLL_table:
forward
if used !#names
 !#names dd RVA _#names ; import name RVAs
 macro names [p] \{     ; call with no
  \common               ; invoke prefix
  pushr p
  call [!#names]
 \}
end if
common dd 0             ; end
forward
if used !#names
_#names dw 0            ; import names
db `names, 0            ; 'import'
end if
}
    


ARRAY.INC

Code:
; $$$$$$$$$$$$$$ Z77 ASM LIBRARY $$$$$$$$$$$$$$$$$
; ************** SUNGOD SOFTWARE *****************
; ????????????????? ARRAY.INC ????????????????????

; array.create &a, s, n   ; s/ize, # indices
; array.size &a, n        ; allocate n # indices
; array.destroy &a        ; deallocate a.p
; array.expand &a         ; allocate n+1
; array.reduce &a         ; allocate n-1
; array.zero &a, i        ; zero element at i/ndex
; array.erase &a          ; zero entire array
; array.index &a, i       ; return element address
; array.insert &a, i, &p  ; insert a[i]=p
; array.attach &a, &p     ; attach to end: a[n-1]
; array.remove &a, i      ; remove a[i]
; array.replace &a, i, &p ; overwrite a[i]=p
; array.shift &a, i, d    ; shift indices 'l'/'r'
; array.exchange...       ; see definitions...
; array.sort &a, !fp
; array.randomize &a
; array.encrypt &a, $p
; array.decrypt &a, $p

macro \
ARRAY.X \   ; define dynamic array structure
name, s {
if ~s eq    ; name is optional
name:
end if
.p dd 0     ; pointer. one contiguous block
.n dd 0     ; # indices
.s dd s     ; element size
.i dd 0     ; id/type/index. example: ID_IMAGE
if.debug    ; if DEBUG was written somewhere
.name: \    ; store its name after
db `name, 0
end if
}

; HL syntax: ARRAY images(IMAGE.$), files(1*KB),\
; my.fonts(FONT.$), text.lines(2*KB), etc

macro ARRAY [p] {
forward
define ?s 0
match name(s), p \{
 verify.size s
 ARRAY.X name, s
 define ?s 1
\}
if ?s eq 0
 'Invalid array syntax'
end if
common
}

ASSUME ?array(1)=ARRAY ; virtual offsets

macro ARRAYS name { ; create inside structure
VOID name#.p
NUMBER name#.n, name#.s, name#.i
}

; BEGIN: P
; END: P+(N*S)
; INDEX: P+(I*S)
; LAST INDEX: P+(N*S)-S or P+((N-1)*S)

; HL array index. parameter is [m]

; @index images[i]
; @index [p]=fonts[i]

macro @index p {
common
define ?s 0
match v==a i, p \{      ; no comma between a,[i]
 get v=array.index a, i
 define ?s 1
\}
match =0 a i, ?s p \{
 array.index a, i
 define ?s 1
\}
if ?s eq
 'Syntax error'
end if
}

macro @create a, s, n { array.create a, s, n }
macro @expand a { array.expand a }

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; index array: &a[i] ([scale*index+base]).
; return element address. if DEBUG was written
; somewhere on a line by itself, this will verify
; that index is within boundaries. otherwise,
; it just produces mul+add with no check.
; "calla !name" is for forward references,
; print/log/etc have not been defined yet

TEXT invalid.index.t='Invalid array index: %t[%n]'

function array.index, a, i
let eax=[i], ecx=[a]
if.debug
  cmp eax, [?array.n+ecx]
  jb .ok
  let edx=&[?array.name+ecx]
  callv !print, [?t], invalid.index.t, edx, eax
  calla !erase.log
  calla !log, [?t]
  calla !execute, log.file
  calla !exit
  escape
  .ok:
end if
mul dword [?array.s+ecx]
add eax, [?array.p+ecx]
endf

; get most recent index: n-1

function array.last, a
let ecx=[a], eax=[?array.n+ecx], eax--
mul dword [?array.s+ecx]
add eax, [?array.p+ecx]
endf

array.recent fix array.last

; zero element at i/ndex

function array.zero, a, i
array.index [a], [i]
let edx=[a]
memory.set eax, 0, [?array.s+edx]
endf

; zero entire array

function array.erase, a
locals i, n
let eax=[a], [n]=[?array.n+eax]
.loop [i]=0 to [n]
  array.zero [a], [i]
.endl
endf

; allocate # indices. a.s must be set first

function array.size, a, n
locals p, size, s
let eax=[a],\
[p]=[?array.p+eax],\           ; p=array.p
edx=[?array.s+eax], [s]=edx,\  ; s=array.s
ecx=[n], [?array.n+eax]=ecx,\  ; array.n=n
ecx*edx, [size]=ecx            ; size=n*s
try allocate.x [p], [size]
let edx=[a],\                  ; return last
[?array.p+edx]=eax,\           ; p+size-s
eax+[size], eax-[?array.s+edx]
endf

; create array

function array.create, a, s, n
let eax=[a], [?array.s+eax]=[s],\
dword [?array.i+eax]=0
array.size [a], [n]
endf

; deallocate array.p

function array.destroy, a
let eax=[a]
destroy [?array.p+eax]
endf

; size array.n+1, allocate element at end

function array.expand, a
let eax=[a], ecx=[?array.n+eax], ecx++
array.size eax, ecx
endf

; size array.n-1, deallocate element at end

function array.reduce, a
let eax=[a], ecx=[?array.n+eax], ecx--
array.size eax, ecx
endf

; replace element at i/ndex with p

function array.replace, a, i, p
array.index [a], [i]
let ecx=[a], ecx=[?array.s+ecx]
memory.copy eax, [p], ecx
endf

; copy element to p

function array.copy, a, i, p
array.index [a], [i]
let ecx=[a], ecx=[?array.s+ecx]
memory.copy [p], eax, ecx
endf

; allocate new element at end then copy

function array.attach, a, p
try array.expand [a]
let edx=[a]
memory.copy eax, [p], [?array.s+edx]
endf

; create/copy literal text array

function array.get.t, a, t, n
locals i, p
array.size [a], [n]
array.erase [a]
.loop [i]=0 to [n]
  try [p]=array.index [a], [i]
  let edx=[t], ecx=[i]
  calla !text.copy, [p], [edx+ecx*4]
.endl
endf

array.create.t fix array.get.t

; shift indices from i-a.n once left or right.
; i=0 to shift all. d/irection='l'/'r'

function array.shift, a, i, d
locals index, s, p
cmp [d], 'r'
je .right
.left:                    ; loop index=i+1 to n
let ecx=[i], ecx++,\
[index]=ecx
@@:
let eax=[a],\
ecx=[?array.n+eax]        ; index>=n?
cmp [index], ecx
jae .ret
let ecx=[index], ecx-1
array.index [a], ecx      ; destiny=a[i-1]
let [p]=eax
array.index [a], [index]  ; source=a[i]
let [s]=eax, eax=[a],\
ecx=[?array.s+eax]
memory.copy [p], [s], ecx
inc [index]
jmp @b
.right:                   ; loopr index=n-1 to i
let eax=[a],\
ecx=[?array.n+eax],\
ecx-1, [index]=ecx
@@:
let ecx=[i]
cmp [index], ecx          ; index<=0?
jb .r
array.index [a], [index]  ; destiny=a[i]
let [p]=eax,\
ecx=[index], ecx-1
array.index [a], ecx      ; source=a[i-1]
let [s]=eax, eax=[a],\
ecx=[?array.s+eax]
memory.copy [p], [s], ecx
dec [index]
jmp @b
endf

; insert element at arbitrary index.
; use .attach for end

function array.insert, a, i, p
array.expand [a]
array.shift [a], [i], 'r'
array.replace [a], [i], [p]
endf

; remove index. use .reduce for end

function array.remove, a, i
let eax=[a], ecx=[?array.n+eax]
cmp [i], ecx
jae .!
array.shift [a], [i], 'l'
array.reduce [a]
endf

; exchange indices i and j using b as a
; temporary buffer (must be element size)

function array.exchange, a, i, j, b
locals n, s, p
let ecx=[a],\
ecx=[?array.s+ecx], [n]=ecx
get [p]=array.index [a], [i]
memory.copy [b], eax, [n]    ; tmp=a[i]
get [s]=array.index [a], [j] ; a[i]=a[j]
memory.copy [p], eax, [n]
memory.copy [s], [b], [n]    ; a[j]=tmp
endf

; sort array in ascending or descending
; order (as='a'/'d'). fp=function pointer
; to: !compare(&a, &b). returns <0>

function array.sort, a, fp, as
locals i, x, s, p, n
let eax=[a],\
[s]=[?array.s+eax],\
[n]=[?array.n+eax],\
[n]-1
get [p]=allocate [s]   ; allocate buffer
fail .r                ; once before loop
.loop [i]=0 to [n]
  let [x]=0
  .compare:            ; loop x=0 to n-i
  let eax=[n], eax-[i]
  cmp [x], eax
  jae .el
  array.index [a], [x] ; compare a[x], a[x+1]
  let ecx=eax, ecx+[s]
  callp fp, eax, ecx
  .if [as] not 'd'     ; ascending? default
    .if eax>0
      jmp .exchange
    .end
  .else                ; descending
    .if eax<0
      jmp .exchange
    .end
  .end
  jmp .next
  .exchange:
  let eax=[x], eax+1
  array.exchange [a], [x], eax, [p]
  .next:
    inc [x]
    jmp .compare
  .el:
.endl
@@:
destroy [p]
let eax=1
endf

; sort number array numerically. as='a'/'d'

macro array.sort.n a, as
{ array.sort a, !n.compare, as }

function n.compare, a, b
let eax=[a], edx=[b], eax=[eax], eax-[edx]
endf

; sort text array alphabetically

macro array.sort.t a, as
{ array.sort a, !text.compare, as }

; sort array of structures based on .member
; value, .n/umber or .t/ext

align 4
NUMBER ?s.m ; virtual .offset

macro array.sorts.n a, m, as {
let [?s.m]=m
array.sort a, !s.n.compare, as
}

macro array.sorts.t a, m, as {
let [?s.m]=m
array.sort a, !s.t.compare, as
}

function s.n.compare, a, b
let eax=[a], edx=[b], ecx=[?s.m],\
eax=[eax+ecx], edx=[edx+ecx], eax-edx
endf

function s.t.compare, a, b
let eax=[a], edx=[b], ecx=[?s.m],\
eax=&[eax+ecx], edx=&[edx+ecx]
calla !text.compare, eax, edx
endf

; shuffle all array indices in a unique
; fashion with no duplicates

function array.randomize, a
locals i, j, n, s, max, p
let eax=[a], [s]=[?array.s+eax],\
[n]=[?array.n+eax], ecx=[n],\
ecx-1, [max]=ecx
get [p]=allocate [s]
fail .r
.loop [i]=0 to [n]
  get [j]=random [max]
  array.exchange [a], [i], [j], [p]
.endl
destroy [p]
endf

; encrypt or decrypt array with password.
; see CRYPT.INC

macro array.encrypt a, password
{ array.crypt a, 1, password }

macro array.decrypt a, password
{ array.crypt a, 0, password }

function array.crypt, a, e, password
locals i, n, s, p
let eax=[a], [s]=[?array.s+eax],\
[n]=[?array.n+eax]
.loop [i]=0 to [n]
  get [p]=array.index [a], [i]
  .if [e]
    encrypt [p], [s], [password]
  .else
    decrypt [p], [s], [password]
  .end
.endl
endf

; to load/save array, see FILE.INC
    
Post 12 Nov 2012, 16:47
View user's profile Send private message Reply with quote
uart777



Joined: 17 Jan 2012
Posts: 369
TEXT.INC

Code:
; $$$$$$$$$$$$$$ Z77 ASM LIBRARY $$$$$$$$$$$$$$$$$
; ************** SUNGOD SOFTWARE *****************
; ????????????????? TEXT.INC ?????????????????????

; set.case c        ; set case sensitivity
; text.n t          ; get # characters (size-1)
; text.write a, b   ; copy but no 0 after
; text.write.x...   ; write starting at i/ndex
; text.copy a, b    ; standard copy with 0 after
; text.copy.n...    ; copy with maximum size
; text.attach a, b  ; attach b to a; "concencate"
; text.attach.c...  ; attach character
; text.attach.n...  ; attach number with alignment
; text.equal a, b   ; equal? return 0 if not
; text.equal.c t, c ; equals character?
; text.compare a, b ; compare alphabetic. return <0>
; text.search a, b  ; search for text. return &/0
; text.find t, c    ; search for character. return &/0
; text.find.last... ; search for c reverse
; text.count.c t, c ; count # c characters
; text.find.p t, c  ; find previous occurance before t
; text.begins a, b  ; begins with b?
; text.ends a, b    ; ends with b?
; text.lower t      ; convert to lowercase
; text.upper t      ; convert to uppercase
; text.reverse t    ; reverse
; text.expand t, n  ; expand; shift right at t
; text.expand.x...  ; expand at index
; text.prefix t, s  ; expand then insert prefix
; text.insert...    ; insert text at index
; text.insert.c...  ; insert character
; text.delete.c...  ; delete c at index
; text.delete t, n  ; delete # characters at t
; text.delete.x...  ; delete # characters at index
; text.enclose...   ; enclose with 'c' 'c'
; text.align...     ; align. example: '0000FFh'
; text.limit...     ; end with '...'

; text.array.equal... ; see definitions
; text.array.search...

; set.base b ; set conversion mode: 'd', 'h', 'b'
; n2t n, $t  ; convert 32BIT number to text
; t2n $t     ; convert text to 32BIT number

; convert.n2t n, $t, b ; see definitions
; convert.t2n $t, b
; ns2t n, $t

; print t, f, ... ; print formatted text

;;;;;;;;;;;;;;; CHARACTER TABLES ;;;;;;;;;;;;;;;;;

; IT - insensitive lookup table. A-Z/a-z are
; the same. this increases processing speed by
; many times. example: if (tt[a]=tt[b]) instead
; of multiple false comparisons per character:
; if ((a>='a'&a<='z')&(b>='a'&b<='z')) |
; ((a>='A'&a<='Z')&(b>='Z'&b<='Z'))

; TT - type lookup table. each byte contains
; C_X BITs to determine its type fast in one
; comparison. example: if tt[c]&SYMBOL

IT db \ ; BYTE IT[128]=
00h,01h,02h,03h,04h,05h,06h,07h,08h,09h,0Ah,0Bh,0Ch,0Dh,0Eh,0Fh,\
10h,11h,12h,13h,14h,15h,16h,17h,18h,19h,1Ah,1Bh,1Ch,1Dh,1Eh,1Fh,\
20h,21h,22h,23h,24h,25h,26h,27h,28h,29h,2Ah,2Bh,2Ch,2Dh,2Eh,2Fh,\
30h,31h,32h,33h,34h,35h,36h,37h,38h,39h,3Ah,3Bh,3Ch,3Dh,3Eh,3Fh,\
40h,41h,42h,43h,44h,45h,46h,47h,48h,49h,4Ah,4Bh,4Ch,4Dh,4Eh,4Fh,\
50h,51h,52h,53h,54h,55h,56h,57h,58h,59h,5Ah,5Bh,5Ch,5Dh,5Eh,5Fh,\
60h,41h,42h,43h,44h,45h,46h,47h,48h,49h,4Ah,4Bh,4Ch,4Dh,4Eh,4Fh,\
50h,51h,52h,53h,54h,55h,56h,57h,58h,59h,5Ah,7Bh,7Ch,7Dh,7Eh,7Fh
TT db \ ; BYTE TT[128]=
00h,80h,80h,80h,80h,80h,80h,80h,80h,80h,40h,80h,80h,40h,80h,80h,\
80h,80h,80h,80h,80h,80h,80h,80h,80h,80h,80h,80h,80h,80h,80h,80h,\
20h,10h,04h,04h,10h,04h,04h,04h,04h,04h,04h,04h,04h,04h,10h,04h,\
01h,01h,01h,01h,01h,01h,01h,01h,01h,01h,04h,04h,04h,04h,04h,10h,\
10h,0Ah,0Ah,0Ah,0Ah,0Ah,0Ah,02h,0Ah,02h,02h,0Ah,02h,0Ah,02h,02h,\
02h,02h,02h,02h,02h,02h,02h,02h,02h,02h,02h,04h,04h,04h,04h,10h,\
04h,0Ah,0Ah,0Ah,0Ah,0Ah,0Ah,02h,0Ah,02h,02h,0Ah,02h,0Ah,02h,02h,\
02h,02h,02h,02h,02h,02h,02h,02h,02h,02h,02h,04h,04h,04h,04h,80h

;            76543210b
C_NULL     = 00000000b ; 0
C_NUMBER   = 00000001b ; 0-9
C_ALPHA    = 00000010b ; A-Z, a-z
C_SYMBOL   = 00000100b ; all symbols except _.?!@$
C_NUMERIC  = 00001000b ; A-F/a-f, h,b,k,m/H,B,K,M
C_SYMBOLIC = 00010000b ; _.?!@$
C_SPACE    = 00100000b ; ' ', '/t'
C_RETURN   = 01000000b ; 0Dh, 0Ah
C_IGNORE   = 10000000b ; extended: 1.XXXXXXXb
C_KEYWORD  = 11111111b

C_DIGIT    = C_NUMBER or C_NUMERIC
C_NAME     = C_ALPHA or C_NUMBER or C_SYMBOLIC
C_SYMBOLS  = C_SYMBOL or C_SYMBOLIC
C_ALPHAN   = C_ALPHA or C_NUMBER
C_VISIBLE  = C_ALPHAN or C_SYMBOLS
C_WHITE    = C_SPACE or C_RETURN
C_BLANK    = C_WHITE or C_IGNORE
C_END      = C_SYMBOL or C_WHITE
C_0        = 0

; is c of type?

macro .if.is c, t {
let ecx=c, ecx&0FFh,\
eax=>[TT+ecx], eax&C_#t
.if true
}

; is cl character type?

macro .if.c c { .if byte [TT+ecx]&C_##c }
macro .if.not.c c { .if.n byte [TT+ecx]&C_##c }
macro .else.if.c c { .else.if byte [TT+ecx]&C_##c }

macro .if.text.equal a, b { !if text.equal, a, b }
macro .if.not.text.equal a, b { !if.n text.equal, a, b }
macro .if.text.find a, b { !if text.find, a, b }
macro .if.text.find.last a, b { !if text.find.last, a, b }
macro .if.text.search a, b { !if text.search, a, b }
macro .if.not.text.search a, b { !if.n text.search, a, b }

C_TEXT=27h
R equ ,0Dh,0Ah,
NL db 0Dh, 0Ah, 0
NO.TEXT db '0', 0

; alternative C names

strlen fix text.n
strcpy fix text.copy
strcmp fix text.compare
strcat fix text.attach
strchr fix text.find
strstr fix text.search

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; set case sensitivity. c=-1 to export case
; and c table addresses

align 4
NUMBER CASE=YES ; sensitive by default

function set.case, c
let eax=[CASE]
.if [c]=-1
  let edx=IT, ecx=TT
.else
  let [CASE]=[c]
.end
endf

; get # characters

function text.n, t
let eax=[t]
.while byte [eax]
  let eax++
.endw
let eax-[t]
endf

; copy a=b with no 0 after

function text.write, a, b
let eax=[a], edx=[b]
.while byte [edx]
  let cl=[edx], [eax]=cl,\
  eax++, edx++
.endw
endf

; write starting at index. no 0 after

function text.write.x, a, b, i
let eax=[a], eax+[i]
text.write eax, [b]
endf

; standard copy with 0. return advanced &

function text.copy, a, b
let eax=[a], edx=[b]
.while byte [edx]
  let cl=[edx], [eax]=cl,\
  eax++, edx++
.endw
let byte [eax]=0
endf

; copy with maximum size specified

function text.copy.n, a, b, n
text.n [b]
inc eax
.if eax<=[n]
  text.copy [a], [b]
.else
  let eax=[a], edx=[b], [n]--
  @@:
   let cl=[edx], [eax]=cl,\
    eax++, edx++, [n]--
  jnz @b
  let byte [eax]=0
.end
endf

; attach b to a. return advanced &

function text.attach, a, b
text.n [a]
let eax+[a]
text.copy eax, [b]
endf

function text.attach.c, t, c
text.n [t]
let eax+[t], ecx=>[c],\
 byte [eax]=cl, byte [eax+1]=0
endf

; attach number with optional alignment or 0

function text.attach.n, t, n, a
locale p, b(256)
let eax=&[b], [p]=eax
calla !n2t, [n], [p]
.if [a]
  calla !text.align, [p], '0', [a]
.end
calla !text.attach, [t], [p]
endf

; equal? return 0 if not

function text.equal, a, b
push esi edi
let eax=[a],\
edx=[b]
.if [CASE]         ; sensitive
  @@:
   let \
   cl=[eax],\
   ch=[edx],\
   eax++, edx++
   cmp cl, ch      ; while *a++=*b++
   jne .r0
   or cl, ch       ; and both nonzero
  jnz @b
  or cl, ch        ; both must=0 at end
  jnz .r0
  jmp .e
.else              ; insensitive
  @@:
   let \
    esi=>[eax],\
    edi=>[edx],\
    cl=[IT+esi],\
    ch=[IT+edi],\
    eax++, edx++
   cmp cl, ch      ; while it[*a++]=it[*b++]
   jne .r0
   or esi, edi     ; and both nonzero
  jnz @b
  or esi, edi      ; both must=0 at end
  jz .e
.end
.r0: let eax=0
.e: pop edi esi
endf

; 'text' equals 'c'haracter?

function text.equal.c, t, c
let eax=[t], ecx=>[c]
cmp byte [eax], cl
jne .r0
let eax++, cl=[eax]
test cl, cl
jz .!
.r0: let eax=0
endf

; lexical comparison. return <0>

function text.compare, a, b
let eax=[a], edx=[b]
@@:
 let cl=[eax],\
  ch=[edx],\
  eax++, edx++
 cmp cl, ch     ; while equal
 jne @f
 or cl, ch      ; and both nonzero
jnz @b
@@:
 sub cl, ch     ; return *a-*b
 movsx eax, cl
endf

; search for character. return &/0

function text.find, t, c
let eax=[t], edx=[c]
@@:
 let cl=[eax]
 cmp cl, dl   ; if *t=c
 je .!        ; return address
 inc eax
 test cl, cl  ; while *t++ not 0
jnz @b
let eax=0
endf

; search for c reverse

function text.find.last, t, c
locals p
let [p]=[t]
text.n [t]      ; start at end-1
let eax+[t],\
 eax-1, edx=[c]
@@:
let cl=[eax]
 test cl, cl
 jz .r0
 cmp [p], eax   ; beginning?
 je .r0
 cmp cl, dl     ; found
 je .!
 dec eax
jmp @b
.r0: let eax=NO
endf

; count # of characters in text

function text.count.c, t, c
locals p, n
let [p]=[t], [n]=0
@@:
get [p]=text.find [p], [c]
.if true
  let [p]++, [n]++
  jmp @b
.end
let eax=[n]
endf

; find previous occurance of c before t

function text.find.p, t, c
let eax=[t], eax--, edx=[c]
.while byte [eax]
  let cl=[eax], eax--
  cmp cl, dl
  je .!
.endw
let eax=0
endf

; search for text. if a contains b. return
; address of first/next appearance or 0
; if none

function text.search, a, b
locals s
push ebx esi edi
let eax=[a], edx=[b]
.if [CASE]            ; sensitive
  push esi
  let esi=edx
  .sl:
   let ch=[edx]
   @@:
    let cl=[eax],\
     eax++
    test cl, cl       ; if *a=0
    jz .r0
    cmp cl, ch        ; while *a++!=*b
   jne @b
   let eax--,\        ; save start address
    [s]=eax
   @@:
    let cl=[eax],\
     ch=[edx],\
     eax++, edx++
    test ch, ch       ; if *b=0
    jz .r1
    cmp cl, ch        ; while *a++=*b++
   je @b
   @@:
    let eax--,\
    edx=esi
  jmp .sl
.else                 ; insensitive
  let ebx=edx,\
   esi=eax, edi=edx
  .il:
   let edi=>[edx],\
    ch=[IT+edi]
   @@:
    let esi=>[eax],\
     cl=[IT+esi],\
     eax++
    or esi, esi       ; if *a=0
    jz .r0
    cmp cl, ch        ; while it[*a++]!=it[*b]
   jne @b
   let eax--, [s]=eax ; save start address
   @@:
    let esi=>[eax],\
     edi=>[edx],\
      cl=[IT+esi],\
      ch=[IT+edi],\
     eax++, edx++
    test edi, edi     ; if *b=0
    jz .r1
    cmp cl, ch        ; while it[*a++]=it[*b++]
   je @b
   let eax--, edx=ebx
  jmp .il
.end
.r0: let eax=NO
 jmp @f
.r1: let eax=[s]
@@:
 pop edi esi ebx
endf

; begins with? return 0 if not

function text.begins, a, b
locals an
push esi edi
get [an]=text.n [a]
text.n [b]
cmp [an], eax       ; an<bn? can't contain
jl .r0
let eax=[a],\
edx=[b]
.if [CASE]          ; sensitive
  @@:
   let cl=[eax],\
    ch=[edx],\
    eax++, edx++
   test cl, ch      ; if either=0
   jz @f
   cmp cl, ch       ; while *a++=*b++
  je @b
  @@:               ; end
   test ch, ch      ; *b must=0
   jnz .r0
   jmp .e
.else               ; insensitive
  @@:
   let esi=>[eax],\
    edi=>[edx],\
     cl=[IT+esi],\
     ch=[IT+edi],\
    eax++, edx++
   test esi, edi    ; if either=0
   jz @f
   cmp cl, ch       ; while it[*a++]=it[*b++]
  je @b
  @@:               ; end
   test edi, edi    ; *b must=0
  jz .e
.end
.r0: let eax=0
.e: pop edi esi
endf

; ends with? return 0 if not

function text.ends, a, b
locals an, bn
get [an]=text.n [a]
get [bn]=text.n [b]
let eax=[a],\       ; eax=&(a+an-bn)
eax+[an], eax-[bn]
text.equal eax, [b] ; equal?
endf

; convert to lowercase

function text.lower, t
let eax=[t]
@@:
 let cl=[eax]
 cmp cl, 'A'
 jl .a
 cmp cl, 'Z'
 jg .a
 add byte [eax], 32
 .a:
 inc eax
 test cl, cl
jnz @b
endf

; convert to uppercase

function text.upper, t
let eax=[t]
@@:
 let cl=[eax]
 cmp cl, 'a'
 jl .a
 cmp cl, 'z'
 jg .a
 sub byte [eax], 32
 .a:
 inc eax
 test cl, cl
jnz @b
endf

; reverse text

function text.reverse, t
let eax=[t],\
 cl=[eax]       ; eax=start
test cl, cl
jz .!
text.n [t]
let edx=[t],\
 edx+eax,\
 edx--, eax=[t]
@@:             ; exchange *eax++/*edx--
 let cl=[eax],\
  ch=[edx],\
  [eax]=ch,\
  [edx]=cl,\
  eax++, edx--
 cmp eax, edx   ; while not end
jb @b
let eax=[t], eax++
endf

; expand; shift all characters right.
; example: 'abc123' becomes 'XXXabc123'
; after expand 3

function text.expand, t, n
locals tn
get [tn]=text.n [t]
let eax+[t], eax--,\
 edx=eax, eax+[n]
@@:
 let cl=[edx], [eax]=cl,\
 eax--, edx--, [tn]--
jnz @b
endf

; expand starting at index

function text.expand.x, t, i, n
let eax=[t], eax+[i]
text.expand eax, [n]
endf

; insert text at beginning

function text.prefix, a, b
text.n [b]
text.expand [a], eax
text.write [a], [b]
endf

; insert text at index

function text.insert, a, b, i
text.n [b]
text.expand.x [a], [i], eax
text.write.x [a], [b], [i]
endf

; insert character at index

function text.insert.c, t, c, i
locals n
get [n]=text.n [t]
.if [i]>=eax
  text.attach.c [t], [c]
.else
  text.expand.x [t], [i], 1
  let eax=[t], edx=eax, eax+[n],\
  eax++, byte [eax]=0, edx+[i],\
  ecx=[c], byte [edx]=cl
.end
endf

; delete character at index

function text.delete.c, t, i
let eax=[t], eax+[i],\
edx=eax, eax++
.if not byte [eax]     ; ending c
  let byte [eax-1]=0
.else                  ; beginning/middle
  text.copy edx, eax
.end
endf

; delete # characters at t. if n>=tn,
; delete all. else, shift all characters to
; the left

function text.delete, t, n
locals tn
get [tn]=text.n [t]
let eax=[t]
.if [n]>=eax
  let byte [eax]=0
.else
  let edx=eax, edx+[n]
  text.copy eax, edx
.end
let eax=[t], eax+[n]
endf

; delete # characters starting at index

function text.delete.x, t, i, n
locals tn
.if [i]=0              ; delete beginning
  text.delete [t], [n]
  escape
.end
get [tn]=text.n [t]
let ecx=[i], ecx+[n]
.if ecx>=eax           ; delete ending
  let eax=[t],\
   ecx=[i],\
   byte [eax+ecx]=0
.else                  ; delete middle
  let eax=[t],\
   edx=eax, ecx=[i],\
   eax+ecx, edx+ecx,\
   edx+[n]
  text.copy eax, edx
.end
endf

; enclose t in 'c'. insert prefix and attach
; b/egin and e/nd characters. example:
; text.enclose t, '(', ')'

function text.enclose, t, b, e
locals n
get [n]=text.n [t]
text.expand [t], 1
let eax=[t], ecx=[b], byte [eax]=cl,\
 eax=[t], eax+[n], eax++, ecx=[e],\
byte [eax]=cl, byte [eax+1]=0
endf

; prefix text with c's ('0', ' ',
; etc) or ensure maximum n. example:
; before: TEXT t='7FAB'
; text.align t, '0', 8
; after: t='00007FAB', aligned to hex32

function text.align, t, c, n
locals tn
get [tn]=text.n [t]
let ecx=[n]
.if eax=ecx          ; same size
  escape             ; do nothing
.end
.if eax>ecx          ; tn>n? exceeds maximum
  let eax=[t],\      ; end at t+n
  byte [eax+ecx]=0
  escape
.end
let ecx-eax, [n]=ecx ; n>tn? expand t
text.expand [t], ecx
let eax=[t], ecx=[n]
@@:
 let edx=>[c],\
 [eax]=dl, eax++, ecx--
jnz @b
let ecx=[tn], byte [eax+ecx]=0
endf

; end text with ... but do not exceed maximum

_dots: db '...', 0

function text.limit, t, max
locals n
get [n]=text.n [t]
let eax=[t], ecx=[max], edx=[_dots]
.if [n]<4
  jmp .copy ; only ...
.end
.if ecx<4   ; max
  let ecx=4
.end
let eax=[t], eax+ecx, eax-4
.copy: let [eax]=edx
endf

; search text array ta for t using text.equal
; and text.search. case is considered.
; return index or -1/INVALID if not found.
; ta is an array of text addresses (TEXTA)

function text.array.equal, ta, t, n
locals i
.loop [i]=0 to [n]
   let eax=[i], eax<<2, eax+[ta]
   .if.text.equal [t], [eax]
      return [i]
   .end
.endl
let eax=-1
endf

function text.array.search, ta, t, n
locals i
.loop [i]=0 to [n]
   let eax=[i], eax<<2, eax+[ta]
   .if.text.search [t], [eax]
      return [i]
   .end
.endl
let eax=-1
endf

; $$$$$$$$$$$$$$ Z77 ASM LIBRARY $$$$$$$$$$$$$$$$$
; ************** SUNGOD SOFTWARE *****************
; ???????????????? CONVERT.INC ???????????????????

; text/number conversions

; n2t n, $t  ; convert 32BIT number to text
; t2n $t     ; convert text to 32BIT number

; set.base b ; set current base

; 'n' - signed integer; default
; 'u' - unsigned decimal
; 'h' - hexadecimal
; 'b' - binary

; n2t.n/u/h/b must return advanced address (*t=0)
; for "print"

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

align 4
NUMBER BASE='n'
_hex: db '0123456789ABCDEF'

; set base for n2t/t2n. b=-1 to get current

function set.base, b
let eax=[BASE]
.if [b] not -1
  let [BASE]=[b]
.end
endf

macro get.base { set.base -1 }
set.mode fix set.base

; n2t(n, $t) - convert 32BIT number to text

function n2t, n, t
.if [n]=0           ; 0 value? most common
  let eax=[t],\
   byte [eax]='0',\
   eax++,\
   byte [eax]=0     ; convert and return
  escape
.end
let eax=[BASE],\    ; select conversion mode...
 ecx=[n], edx=[t]
test eax, eax       ; 0=default
jz .default
cmp eax, 'n'        ; signed decimal
je .default
.if eax='u'         ; unsigned decimal
  let eax=!n2t.u
.else.if eax='h'    ; hexadecimal
  let eax=!n2t.h
.else.if eax='b'    ; binary
  let eax=!n2t.b
.else
  .default:
  let eax=!n2t.n
.end
calla eax, ecx, edx
endf

; signed number to text

function n2t.n, n, t
push ebx esi edi
let eax=[n], edi=[t]
test eax, eax
jnz .sign
.zero:
 let byte [edi]='0',\
  edi+2, byte [edi]=0, eax=edi
 jmp .e
.sign:
 jns @f
 let byte [edi]='-', edi++, [t]++
 neg eax
@@:
 let ecx=0CCCCCCCDh, esi=edi
.while eax>0
  let ebx=eax
  mul ecx
  let edx>>>3, eax=edx,\
   edx=&[edx+edx*4], edx+edx,\
   ebx-edx, bl+'0',\
  [edi]=bl, edi++
.endw
let byte [edi]=0
push edi
text.reverse [t]
pop eax
.e:
pop edi esi ebx
endf

; unsigned number to text

function n2t.u, n, t
push ebx esi edi
let eax=[n], edi=[t],\
 esi=edi, ecx=1999999Ah
@@:
 let ebx=eax
 mul ecx
 let eax=edx,\
  edx=&[edx*4+edx],\
  edx+edx, ebx-edx,\
  bl+'0', [edi]=bl, edi++
 test eax, eax
jnz @b
let byte [edi]=0
push edi
text.reverse [t]
pop eax
pop edi esi ebx
endf

function n2t.h, n, t   ; number to hexadecimal text
let eax=[n], edx=[t]
@@:
 let ecx=>al, ecx&15,\ ; *t++=*(_hex+(n&(16-1)))
  ecx=>[_hex+ecx],\
  [edx]=cl, edx++,\
 eax>>>4               ; n/16
jnz @b
let byte [edx]=0
push edx
text.reverse [t]
pop eax
endf

function n2t.b, n, t       ; number to binary text
let eax=[n], edx=[t]
@@:
 let cl=al, cl&1, cl+'0',\ ; *t++=n&(2-1)+'0'
 [edx]=cl, edx++,\         ; n/2
 eax>>>1
jnz @b
let byte [edx]=0
push edx
text.reverse [t]
pop eax
endf

; t2n($t) - convert text to 32BIT number

function t2n, t
let edx=[t]
.while byte [edx]='0' ; skip preceding '0's...
  let edx++
.endw
.if not byte [edx]    ; 0 value? most common
  let eax=0
  escape
.end
let eax=[BASE]        ; select conversion mode...
test eax, eax         ; 0=default
jz .default
cmp eax, 'n'          ; signed decimal
je .default
.if eax='u'           ; unsigned decimal
  let eax=!t2n.u
.else.if eax='h'      ; hexadecimal
  let eax=!t2n.h
.else.if eax='b'      ; binary
  let eax=!t2n.b
.else
  .default:
  let eax=!t2n.n
.end
calla eax, edx
endf

function t2n.n, t      ; text to signed number
locals negate
let edx=[t],\
 [negate]=0
cmp byte [edx], '-'    ; negative?
jne @f
let edx++, [negate]=1  ; skip
@@:
 calla !t2n.u, edx
 .if [negate]
   neg eax
 .end
endf

function t2n.u, t      ; text to unsigned number
let edx=[t], eax=0
@@:
 let ecx=>[edx], edx++
 test ecx, ecx
 jz @f
 let \
  eax=&[eax+eax*4],\   ; n=n*10+*t++-'0'
  eax=&[eax+eax-'0'],\
 eax+ecx
jmp @b
@@:
endf

function t2n.h, t      ; hexadecimal text to number
let edx=[t], eax=0
@@:
 let ecx=>[edx], edx++
 test ecx, ecx
 jz .e
 shl eax, 4            ; n=n*16+c2h(*t++)
 cmp ecx, '9'          ; 0-9
 jle .n
 cmp ecx, 'a'          ; A-F
 jl .a
 sub ecx, 'a'-10       ; a-f
 jmp .next
 .a:
  sub ecx, 'A'-10
  jmp .next
 .n:
  sub ecx, '0'
 .next:
  add eax, ecx
jmp @b
.e:
endf

function t2n.b, t      ; binary text to number
let edx=[t], eax=0
@@:
 let ecx=>[edx], edx++
 test ecx, ecx
 jz @f
 let eax<<1,\
 eax=&[eax+ecx-'0']    ; n=n*2+*t++-'0'
jmp @b
@@:
endf

macro convert.n2t n, t, b {
push [BASE]
let [BASE]=b
n2t n, t
pop [BASE]
}

macro convert.t2n t, b {
push [BASE]
let [BASE]=b
t2n t
pop [BASE]
}

; convert numeric size to compact text
; to display in file viewers, progress
; indicators, etc. examples: 4096='4k',
; 16777216='16m', 2147483648='2g'.
; note: unsigned 32BIT arithmetic

TEXT max.size.t='>4GB'

function ns2t, n, t
locals suffix
let eax=[n]
cmp eax, KB
 jae @f
 let ecx='b'
 jmp .e
@@:
cmp eax, MB
 jae @f
 let eax>>>10, ecx='k'
 jmp .e
@@:
cmp eax, GB
 jae @f
 let eax>>>20, ecx='m'
 jmp .e
@@:
cmp eax, ((4*GB)-1)
 jbe @f
 text.copy [t], max.size.t
 escape
@@:
let eax>>>30, ecx='g'
.e:
let [n]=eax, [suffix]=ecx
convert.n2t [n], [t], 'u'
text.attach.c [t], [suffix]
endf

; $$$$$$$$$$$$$$$ Z77 ASM LIBRARY $$$$$$$$$$$$$$$$
; *************** SUNGOD SOFTWARE ****************
; ?????????????????? PRINT.INC ???????????????????

; print t, f, ... - print formatted text to buffer.
; a fast alternative to "wsprintfA" that supports
; binary and is easily portable with minimal
; editing. only about 100 lines!

; %t %s    - 'text'; "string"
; %c       - character
; %n %i %d - 32BIT decimal signed
; %u       - 32BIT decimal unsigned
; %b       - 32BIT binary
; %h %x    - 32BIT hexadecimal
; %r       - return. insert 0Dh, 0Ah
; %0       - 0/NULL
; %%       - %

macro print t, f, [p] {
common callv !print, t, f, p
}

; see SYNTAX.INC for callv (with variable
; arguments). it will push invisible n
; (# parameters) then adjust esp after

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

!print:            ; !print(n, $t, $f, ...)
va.n equ esp+4     ; # va
va.i equ edx+ecx*4 ; current va

let \
eax=[esp+8],\      ; text buffer
ecx=[esp+12],\     ; format
edx=&[esp+16]      ; &va[...] start

push esi edi
let edi=eax,\
 esi=ecx, ecx=0    ; index=0
test edi, esi      ; if either address=0
jz .r0             ; return 0

.get:              ; while *text {
let al=[esi]       ; get character
test al, al        ; if *text=0, end
jz .e
let esi++
cmp al, '%'        ; if *text=%
je .key            ; format
.1:                ; else, copy 1 char
let [edi]=al,\     ; to *buffer++
 edi++
jmp .get           ; }

.key:              ; % format key
let eax=>[esi],\   ; get character
 esi++
cmp eax, '%'       ; %% for one %
je .1
cmp eax, '0'       ; %0=NULL?
jz .0
cmp eax, 'a'       ; must be lowercase
jl .x
cmp eax, 'z'
jg .x

; fast a-z jmp table!

sub eax, 97
jmp dword [.jt+eax*4]

align 8
.jt: dd \
.x,.b,.c,.n,.x,.x,.x,.h,.n,\ ; a-i
.x,.x,.x,.x,.n,.x,.x,.x,.r,\ ; j-r
.t,.t,.u,.x,.x,.h,.x,.x      ; s-z
.a: dd 0

.x:                ; unrecognized %?
let byte \
 [edi]='?', edi++  ; replace with ?
jmp .get

.0:                ; 0=NULL
let byte \
 [edi]=0, edi++
jmp .get

.r:
let word \         ; return: CR=0Dh, LF=0Ah
[edi]=0A0Dh, edi+2 ; low endian
jmp .get

.c:                ; %c
let al=[va.i],\    ; get va[i++]
ecx++, [edi]=al,\
edi++
jmp .get

.t:                ; %t %s - text
let eax=[va.i],\   ; get va[i++]
 ecx++
test eax, eax      ; if text=0? error
jz .r0
pusha
text.copy edi, eax ; copy text
let [.a]=eax       ; save end address
popa
let edi=[.a]       ; advance text buffer
jmp .get

.n: let eax='n'    ; %n %i %d - number
 jmp .number
.u: let eax='u'    ; %u
 jmp .number
.h: let eax='h'    ; %h %x
 jmp .number
.b: let eax='b'    ; %b

.number:
push [BASE]
let [BASE]=eax,\   ; get va[i++]
 eax=[va.i], ecx++
pusha
n2t eax, edi       ; copy/convert number to text
let [.a]=eax       ; save end address
popa
pop [BASE]
let edi=[.a]       ; advance text buffer
jmp .get

.r0: let eax=0
jmp @f
.e:
let eax=edi,\      ; return end address
 byte [eax]=0      ; terminate
@@:
pop edi esi
ret                ; callv will adjust esp after
    
Post 12 Nov 2012, 16:53
View user's profile Send private message Reply with quote
uart777



Joined: 17 Jan 2012
Posts: 369
FILE.INC

Code:
; $$$$$$$$$$$$$$ Z77 ASM LIBRARY $$$$$$$$$$$$$$$$$
; ************** SUNGOD SOFTWARE *****************
; ?????????????????? FILE.INC ????????????????????

; open $file   ; attempt open, fail if non-existent
; create $file ; create, replace if exists
; exists $file ; does file exist?
; close        ; close current file

; tell         ; get location
; seek n       ; set location
; seek.r n, r  ; seek relative. r=0/1/2=b/c/e

; read/write to/from current file

; read &p, n      ; read/write memory
; write &p, n
; read.bit        ; read/write 1BIT
; write.bit b
; read.nibble     ; read/write 4BIT
; write.nibble n
; read.c          ; read/write 8BIT byte
; write.c c
; read.n          ; read/write 32BIT number
; write.n n
; read.text $t, n ; until 0 or max
; read.line $t, n ; until NL or max
; write.text $t   ; not including 0
; write.string $t ; including 0
; write.line $t   ; insert NL after
; write.x ...     ; formatted text

; * load.file $file - open, allocate file.p,
; read then close
; * save.file $file, &p, n - create, write p
; then close
; * append.file $file, &p, n - open, attach p
; to file then close
; * flush - deallocate file.p

; array.load &a, $file ; ARRAY.INC
; array.save &a, $file

; copy.file $a, $b, replace
; move.file $a, $b
; delete.file $file
; rename.file $old, $new

; execute $file
; execute.file $file, $action, $ps, show
; execute.program $file, $ps, show, time

                      ; b='C:\FILE.EXT'
; extract.path $a, $b ; a='C:\'
; extract.file $a, $b ; a='FILE.EXT'
; extract.ext $a, $b  ; a='.EXT'
; remove.ext $a
; change.ext $a, $b   ; replace or attach new

; get.directory       ; update [directory]
; up.directory        ; ...
; set.directory $t    ; 'C:\MY\ART\'
; set.folder $t       ; 'IMAGE\'
; reset.directory     ; original
; create.directory $t ; 'C:\MY\VIDEOS\'
; create.folder $t    ; 'FONT\'

; note: in Z77 terminology, a "folder" is
; a simple \NAME\ in the current directory
; or relative path

; find.first $ext ; example: '*.bmp'
; find.next
; find.end
; $found.file     ; result

; where.is folder ; search for folder

; get.file.attributes file
; get.modified.date file, t
; get.modified.time file, t

; log $t ; append message to log.txt

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; current file structure

align 8
VOID file.p      ; pointer for load/save
NUMBER file.h,\  ; handle
file.n64, file.n ; size 64:32

function _file_
let eax=file.p
endf

;;;;;;;;;; OPEN, CREATE, CLOSE, EXISTS ;;;;;;;;;;;

function close
os.close
let [file.h]=-1, eax=YES
endf

function open, file
os.open [file]
.if eax=-1
  return 0
.end
os.get.file.size
let [file.n]=eax, eax=[file.h]
endf

function create, file
os.create [file]
.if eax=-1
  return 0
.end
let [file.n]=0
endf

function exists, file
open [file]
push eax
close
pop eax
endf

macro .if.exists f { !if exists, f }

;;;;;;;;;;;;;;; GET/SET LOCATION ;;;;;;;;;;;;;;;;;

function seek.r, n, r
os.seek [n], [r]
endf

macro seek n { seek.r n, 0 }

macro tell { seek.r 0, 1 }

;;;;;;;;;;;;; READ/WRITE DATA/TEXT ;;;;;;;;;;;;;;;

function read, p, n
os.read [p], [n]
endf

function write, p, n
os.write [p], [n]
endf

function read.c
locals c
let eax=&[c], dword [eax]=0
read eax, 1
let eax=[c]
endf

function write.c, c
let eax=&[c]
write eax, 1
endf

function read.n
locals n
let eax=&[n], dword [eax]=0
read eax, 4
let eax=[n]
endf

function write.n, n
let eax=&[n]
write eax, 4
endf

; read.text/line have not been tested...

function read.text, t, max
push esi edi
let edi=[t], esi=[max]
@@:
 read edi, 1
 cmp byte [edi], 0
 je @f
 let edi++, esi--
jnz @b
@@:
let byte [edi]=0
pop edi esi
endf

function read.line, t, max
push esi edi
let edi=[t],\
esi=[max]
@@:
 read edi, 1      ; read until 0 or 0Dh or max
 let cl=[edi]
 test cl, cl      ; 0
 jz @f
 cmp cl, 0Dh      ; 0Dh
 je @f
 let edi++, esi--
jnz @b            ; max?
@@:
let byte [edi]=0
.if cl=0Dh
  readc
.end
let byte [edi]=0  ; replace with 0
pop edi esi
endf

function write.text, t
text.n [t]
write [t], eax
endf

function write.string, t
text.n [t]
inc eax ; +0
write [t], eax
endf

function write.line, t
write.text [t]
write.text NL
endf

macro write.texts [t] { forward write.text t }

macro write.lines [t] { forward write.line t }

macro write.text.x f, [p] {
common print [?t], f, p ; alters ?t
write.text [?t]
}

; read/write individual bit from left (7)
; to right (0): 76543210. file # BITs must be
; aligned to byte (&7). example: if 17 BITs,
; write 3 bytes. get/set/zero bit are macros
; defined in MEMORY.INC

align 4
NUMBER c.bit, c.byte, next.byte

function read.bit
dec [c.bit]
.if [c.bit]<0 ; read first/next byte
  get [c.byte]=read.c
  let [c.bit]=7
.end
get.bit [c.byte], [c.bit] ; first/next bit
and eax, 1
endf

function write.bit, b
locals n
let eax=7, eax-[c.bit], [n]=eax
.if [b]
  set.bit [c.byte], [n]
.else
  zero.bit [c.byte], [n]
.end
inc [c.bit]
.if [c.bit]>7
  write.c [c.byte]
  let [c.bit]=0
.end
endf

; read/write 4BITs. next.byte must = 0
; on first call

function read.nibble
xor [next.byte], 1
.if [next.byte]
  get [c.byte]=read.c
  let eax>>4, eax&1111b
.else
  let eax=[c.byte], eax&1111b
.end
endf

function write.nibble, b
let eax=[c.byte], ecx=[b], ecx&1111b
.if [next.byte]
  let eax|ecx
  write.c eax
.else
  let ecx<<4, eax|ecx, [c.byte]=eax
.end
endf

;;;;;;;;;;;;;;;; LOAD/SAVE MEMORY ;;;;;;;;;;;;;;;;

function load.file, file
open [file]
fail .r0
get [file.p]=allocate [file.n]
fail .r0
read [file.p], [file.n]
fail .r0
close
let eax=[file.p], ecx=[file.n]
return
.r0:
close
let eax=0
endf

function save.file, file, p, n
create [file]
fail .r0
write [p], [n]
fail .r0
close
let eax=YES
return
.r0:
close
let eax=0
endf

function load.text, file
open [file]
fail .r0
let eax=[file.n], eax+1
get [file.p]=allocate eax
fail .r0
read [file.p], [file.n]
fail .r0
close
let eax=[file.p],\
ecx=[file.n], byte [eax+ecx]=0
return
.r0:
close
let eax=0
endf

function save.text, file, text
text.n [text]
save.file [file], [text], eax
endf

function append.file, file, p, n
!if open, [file]
  seek.r 0, SEEK_END
.else
  create [file]
  fail .e
.end
write [p], [n]
fail .e
close
let eax=[file]
return
.e:
close
let eax=0
endf

; load/save dynamic array. size=file.n/a.s

function array.load, a, file
locals i, n, s, p
try open [file]
let eax=[file.n], edx=[a],\
ecx=[?array.s+edx], [s]=ecx,\
eax/ecx, [n]=eax
array.size [a], [n]
array.erase [a]
.loop [i]=0 to [n]
  get [p]=array.index [a], [i]
  read [p], [s]
  fail .r0
.endl
close
return 1
.r0:
close
let eax=0
endf

function array.save, a, file
locals i, n, s, p
try create [file]
let eax=[a], [s]=[?array.s+eax],\
[n]=[?array.n+eax]
.loop [i]=0 to [n]
  get [p]=array.index [a], [i]
  write [p], [s]
  fail .r0
.endl
close
return 1
.r0:
close
let eax=0
endf

macro flush { destroy [file.p] }

;;;;;;;;;;; COPY, MOVE, DELETE, RENAME ;;;;;;;;;;;

function copy.file, a, b, r
os.copy.file [a], [b], [r]
endf

function move.file, a, b
os.move.file [a], [b]
endf

function delete.file, file
os.delete.file [file]
endf

function rename.file, file
os.rename.file [file]
endf

;;;;;;;;;;;;;;;;;;;; EXECUTE ;;;;;;;;;;;;;;;;;;;;;

function execute, file
os.execute [file]
endf

function execute.file, file, ps, action, show
os.execute.file [file], [ps], [action], [show]
endf

function execute.program, file, ps, show, time
os.execute.program [file], [ps], [action], [time]
endf

;;;;;;;;;;;;;;;; PARSE FILENAME ;;;;;;;;;;;;;;;;;;

function extract.path, a, b
text.copy [a], [b]
.if.text.find.last [a], '\'
  let eax++, byte [eax]=0
.end
endf

function extract.file, a, b
.if.text.find.last [b], '\'
  let eax++
  text.copy [a], eax
.end
endf

function extract.ext, a, b
.if.text.find.last [b], '.'
  text.copy [a], eax
.end
endf

function remove.ext, t
.if.text.find.last [t], '.'
  let byte [eax]=0
.end
endf

function change.ext, a, b
.if.text.find.last [a], '.'
  text.copy eax, [b]
.else
  text.attach [a], [b]
.end
endf

;;;;;;;;;;; DIRECTORY: GET/SET/CREATE ;;;;;;;;;;;;

function get.directory
os.get.directory
let eax=[directory]
endf

function set.directory, t
text.copy [directory], [t]
os.set.directory [t]
endf

function up.directory
get.directory
extract.path [directory], [directory]
set.directory [directory]
endf

function set.folder, name
get.directory
text.attach.c [directory], '\'
text.attach [directory], [name]
set.directory [directory]
endf

function reset.directory
os.get.file.name
extract.path [directory], [directory]
set.directory [directory]
endf

function create.directory, path
os.create.directory [path]
endf

function create.folder, name
get.directory
text.attach.c [directory], '\'
text.attach [directory], [name]
os.create.directory [directory]
endf

;;;;;;;;;;;;;;;;;; FIND FILES ;;;;;;;;;;;;;;;;;;;;

NUMBER find.data.h
found.file equ os.found.file

function find.first, file
jmp @f
os.find.data
@@:
os.find.first [file]
let [find.data.h]=eax, eax++
endf

function find.next
os.find.next
endf

function find.end
os.find.end
endf

; create dynamic text array containing all
; filenames of *.EXT in current directory
; or return 0 if there are none

function find.files, a, ext
try find.first [ext]
@@:
 array.expand [a]
 text.copy eax, os.found.file
 find.next
success @b
find.end
endf

;;;;;;;;;;;;;;;;;;;;; LOCATE ;;;;;;;;;;;;;;;;;;;;;

; set directory containing \FOLDER\ (relative
; path). it may be located in the current
; directory or 1-2 higher directories (for
; \PROJECTS\NAME\). return 0 if not found
; anywhere. example: where.is font.folder

function where.is, folder
set.folder [folder] ; \FOLDER\
success .!
up.directory
set.folder [folder] ; \..\FOLDER\
success .!
up.directory
set.folder [folder] ; \..\..\FOLDER\
endf

; locate folder, search for files of *.EXT
; then reset current directory

function find.files.in, folder, files, ext
where.is [folder]
fail @f
find.files [files], [ext]
@@: reset.directory
endf

;;;;;;;;;;;;;;; FILE ATTRIBUTES  ;;;;;;;;;;;;;;;;;

os.file.attribute.data

function get.file.attributes, file
os.get.file.attributes [file]
endf

function get.file.time, file
os.get.file.time [file]
endf

function get.modified.time, file, t
os.get.modified.time [file], [t]
endf

function get.modified.date, file, t
os.get.modified.date [file], [t]
endf

;;;;;;;;;;;;;;;;;;; FILE TYPES ;;;;;;;;;;;;;;;;;;;

; most common file types for custom file dialog/
; explorer. uncommon types will have a generic
; "File" icon

macro define.file.types {
TEXT \
file.type.text='txt',\
file.type.document='rtf,doc,pub,pdf',\
file.type.source='asm,inc,c,cpp,h,7',\
file.type.program='exe,scr',\
file.type.system='dll,ini,sys',\
file.type.image=\
'bmp,jpg,jpeg,gif,png,tga,tif,pcx',\
file.type.sound='wav,mp3,mid,wma',\
file.type.movie=\
'avi,mp4,mpeg,mpg,wmv,flv,mov',\
file.type.site='htm,html'
}

;;;;;;;;;;;;;;;;;;;;; LOG ;;;;;;;;;;;;;;;;;;;;;;;;

; log t - append 'text' to log file

BOOLEAN create.log?=YES,\
log.star?=YES, log.nl?=YES
TEXT log.file(16)='LOG.TXT', log.star='* '

function log, t
pusha
.if [create.log?]=YES
  create log.file
  close
  let [create.log?]=NO
.end
.if.text.equal [t], NL ; just NL? 0Dh, 0Ah
  append.file log.file, NL, 2
.else
  .if [log.star?]=YES  ; * prefix?
    append.file log.file, log.star, 2
  .end
    text.n [t]         ; append message
    append.file log.file, [t], eax
  .if [log.nl?]=YES    ; NL after?
    append.file log.file, NL, 2
  .end
.end
popa
endf

function log.n, n ; log number
localt t
pusha
let ecx=&[t]
calla !n2t, [n], ecx
let ecx=&[t]
log ecx
popa
endf

macro logs [t] { forward log t }

macro show.log { execute log.file }

function erase.log
create log.file
close
let [create.log?]=NO
endf
    
Post 12 Nov 2012, 16:53
View user's profile Send private message Reply with quote
uart777



Joined: 17 Jan 2012
Posts: 369
DRAW.INC

Code:
; $$$$$$$$$$$$$$$ Z77 ASM LIBRARY $$$$$$$$$$$$$$$$
; *************** SUNGOD SOFTWARE ****************
; ?????????????????? DRAW.INC ????????????????????

include 'color.inc'
include 'clip.inc'
include 'box.inc'

; set.screen w, h, c
; set.screen.color c
; set.screen.size w, h
; clear.screen

; xy x, y        ; ((screen.w<<2)*y)+(x<<2)
; vga.xy x, y    ; &vga[xy(x,y)]
; get.color x, y ; vga[xy(x,y)]

; drawing functions. all draw to current screen
; (vga) and perform "clipping"

; draw.pixel x, y, color
; draw.line orient, x, y, n, color
; draw.line.x x1, y1, x2, y2, color
; draw.box x, y, w, h, color, solid
; draw.box.b box, c, s
; draw.box.s box, c
; draw.box.o box, c

; draw.scanline &pixels, x, y, w, key, alpha
; draw.bitmap &pixels, x, y, w, h, key, alpha
; draw.line.dash orient, x, y, n, c1, c2, w1, w2
; draw.bound box, c1, c2, w1, w2
; draw.bound.x box, b
; draw.arrow way, box, c
; draw.arrow.star box, n, c
; draw.arrow.box way, box, i, n, a, b, c
; draw.lever box, n, d, a, b, c
; draw.panel box, lt, l, c, d, dk
; draw.fade o, box, a, b, n
; draw.chrome o, box, a, b, n

TYPE POINT = NUMBER x, y
TYPE SIZE  = NUMBER w, h
TYPE LINE  = POINT a, b

STRUCTURE POLYGON
 VOID vertices
 NUMBER n, style
 COLOR color
ENDS

ASSUME ?point=POINT, ?size=SIZE,\
?line=LINE, ?polygon=POLYGON

; graphic styles

powers G_STATIC, G_DYNAMIC,\
G_VERTICAL, G_INVERT, G_COLOR, G_LINE,\
G_TEXT, G_FADE, G_CHROME, G_GRADIENT,\
G_IMAGE, G_BRUSH, G_TEXTURE, G_KEY, G_ALPHA

G_DEFAULT      = G_DYNAMIC+G_COLOR+G_LINE
G_DEFAULT_TEXT = G_DEFAULT+G_TEXT
G_TEXT_ONLY    = G_DYNAMIC+G_TEXT
G_ALPHA_FADE   = G_DYNAMIC+G_COLOR+G_ALPHA+G_FADE

;;;;;;;;;;;;;;;;;;; RESOLUTION ;;;;;;;;;;;;;;;;;;;

STRUCTURE RESOLUTION
 TEXT name(16)
 NUMBER w, h, bpp
ENDS

macro resolution [p] {
common
resolutions:
 forward
 match name==w*h, p \{
  TEXT name\#.name(16)=\`name
  NUMBER name\#.w=w,\
  name\#.h=h, name\#.bpp=32
  \}
}

macro define.resolutions {
resolution \
QQVGA  = 160*120,\
HQVGA  = 240*160,\
QVGA   = 320*240,\
WQVGA  = 480*272,\
VGA    = 640*480,\
NTSC   = 720*480,\
WVGA   = 800*480,\
SVGA   = 800*600,\
WSVGA  = 1024*600,\
XGA    = 1024*768,\
SXGA   = 1280*1024,\
HD720  = 1280*720,\
WXGA   = 1280*800,\
WSXGA  = 1440*900,\
HD1080 = 1920*1080
}

;;;;;;;;;;;;;;;;;;;; SCREEN ;;;;;;;;;;;;;;;;;;;;;;

; "Video Graphics Array" and screen structure.
; everything is drawn to this then copied to
; primary display

align 8

VOID vga

NUMBER screen.x, screen.y,\
screen.w=DETECT, screen.h=DETECT,\
screen.bpp=32, screen.key, screen.alpha
COLOR screen.color=BLACK
BOOLEAN clear.screen?=YES
NUMBER screen.delay ; in MS

; current graphics color, box, etc

COLOR g.color, g.line.color
BOX g.box
NUMBER g.style, g.orient, g.solid

; set screen size and color variables.
; return &&[vga] address in eax and
; graphics box & in edx

function set.screen, w, h, c
cmp [w], 0
je @f
let [screen.w]=[w], [screen.h]=[h],\
[screen.color]=[c]
@@: eax=vga, edx=g.box
endf

macro set.screen.color c
{ let [screen.color]=c }
macro set.screen.size w, h
{ let [screen.w]=w, [screen.h]=h }

; calculate &vga[((screen.w<<2)*y)+(x<<2)]
; convert x/y to linear index. warning:
; eax/ecx/edx cannot be sent as parameters
; to macros xy/vga.xy, but registers can
; always be sent to functions

macro xy x, y {
let ecx=[screen.w], ecx<<2, ecx*y,\
 edx=x, eax=&[ecx+edx*4]
}

macro vga.xy x, y {  ; &vga[xy(x,y)]
xy x, y
add eax, [vga]
}

function vga_xy, x, y ; callable version
vga.xy [x], [y]
endf

; get color/[value] at x/y

function get.color, x, y
vga.xy [x], [y]
let eax=[eax]
endf

; set current graphics color

macro set.color c { let [g.color]=c }
macro set.line.color c { let [g.line.color]=c }

; get/set graphics box. w/h are optional

macro locate x, y, w, h {
let [g.box.x]=x, [g.box.y]=y
if w eq
 let [g.box.w]=w, [g.box.h]=h
end if
}

macro get.g.box b { copy.box b, g.box }
macro set.g.box b { copy.box g.box, b }

; set orientation

macro set.orient o { let g.orient=o }

;;;;;;;;;;;;;;;;;;; DRAWING ;;;;;;;;;;;;;;;;;;;;;;

; clear screen. copy w*h # dwords

function clear.screen
push edi
let edi=[vga], eax=[screen.color],\
ecx=[screen.w], ecx*[screen.h]
rep stosd
pop edi
endf

; draw pixel at x/y with c/olor. this is only
; provided for testing algorithms. none of the
; drawing functions use it, they copy directly
; to [vga]. when drawing lines, shapes, images,
; etc, it's best to get the x/y offset once
; before loops then just increment/add/etc
; inside and not re-evaluate the expression
; each iteration

function draw.pixel, x, y, c
try clip.pixel \ ; visible?
[x], [y]
vga.xy [x], [y]  ; &vga[((screen.w<<2)*y)+(x<<2)]
let ecx=[c],\
dword [eax]=ecx  ; copy pixel: *vga=c
endf

; draw straight line fast. o/rient='h'/'v'.
; n=w/h. return if 100% invisible

function draw.line, o, x, y, n, c
push edi
let eax=&[x], edx=&[y], ecx=&[n]
clip.line [o], eax, edx, ecx
fail .e
vga.xy [x], [y]  ; &vga[((screen.w<<2)*y)+(x<<2)]
let edi=eax,\
eax=[c], ecx=[n]
cmp [o], 'v'
je .vertical
.horizontal:
 rep stosd       ; memory.set
 jmp .e
.vertical:
 .loop ecx=0 to [n] ; loop y to h
   let [edi]=eax,\  ; draw pixel
   edx=[screen.w],\
   edi=&[edi+edx*4] ; advance vga+(screen.w*4)
 .endl
.e:
pop edi
endf

macro draw.line.h x, y, n, c
{ draw.line 'h', x, y, n, c }
macro draw.line.v x, y, n, c
{ draw.line 'v', x, y, n, c }

; draw H/V line using current graphics box

function draw.line.z
.if [g.way]='v'
  let eax=[g.box.h]
.else
  let eax=[g.box.w]
.end
draw.line [g.orient],\
[g.box.x], [g.box.y], eax, [g.color]
endf

; draw arbitrary line from x1/y1 to x2/y2.
; not fully optimized yet

function draw.line.a, x1, y1, x2, y2, c
locals i, x, y, px, py, dx, dy
let eax=[x2], eax-[x1], [dx]=eax,\
ecx=[y2], ecx-[y1], [dy]=ecx,\
eax>>1, [x]=eax, ecx>>1, [y]=ecx,\
[px]=[x1], [py]=[y1]
vga.xy [px], [py]
let [eax]=[c], ecx=[dy]
.if [dx]>ecx
  .loop [i]=0 to [dx]
    let eax=[y], eax+[dy], [y]=eax
    .if eax>=[dx]
      let eax=[dx], [y]-eax, [py]++
    .end
    let [px]++
    draw.pixel [px], [py], [c]
  .endl
.else
  .loop [i]=0 to [dy]
    let eax=[x], eax+[dx], [x]=eax
    .if eax>=[dy]
      let eax=[dy], [x]-eax, [px]++
    .end
    let [py]++
    draw.pixel [px], [py], [c]
  .endl
.end
endf

; draw box/square/rectangle. s/olid? 1=yes,
; 0=outline. return if 100% invisible

function draw.box, x, y, w, h, c, s
locals i, b
try visible [x], [y], [w], [h]
.if [s]=YES ; solid?
  let ecx=[y], ecx+[h], [b]=ecx
  .loop [i]=[y] to [b]
    draw.line 'h', [x], [i], [w], [c]
  .endl
.else ; outline
  draw.line 'h', [x], [y], [w], [c] ; top
  let eax=[y], eax+[h], eax-1
  draw.line 'h', [x], eax, [w], [c] ; bottom
  let eax=[y], eax+1, ecx=[h], ecx-2
  draw.line 'v', [x], eax, ecx, [c] ; left
  let eax=[x], eax+[w], eax-1,\
  edx=[y], edx+1, ecx=[h], ecx-2
  draw.line 'v', eax, edx, ecx, [c] ; right
.end
endf

; draw via BOX (x/y/w/h) structure with
; c/olor. s/olid? 1=yes or 0=outline

function draw.box.b, box, c, s
let eax=[box]
draw.box [?box.x+eax], [?box.y+eax],\
[?box.w+eax], [?box.h+eax], [c], [s]
endf

; draw solid or outline

macro draw.box.s box, c { draw.box.b box, c, 1 }
macro draw.box.o box, c { draw.box.b box, c, 0 }

; draw with fill color and outline

function draw.box.bo, box, c1, c2
draw.box.s [box], [c1]
draw.box.o [box], [c2]
endf

; draw with current graphics box

function draw.box.z
draw.box [g.box.x], [g.box.y],\
[g.box.w], [g.box.h], [g.color], [g.solid]
endf

; draw arrow. o/rient='l/u/r/d/ul/ur/dr/dl'.
; for measures, switches, scroll bars.
; w/h must be same size. unfinished...

function draw.arrow, o, box, c
locals i, x, y, w, h, first, last
get.s eax, ?box, box, x, y, w, h
.if [o]='l'
  let eax=[x], [first]=eax, eax+[w], [last]=eax,\
   ecx=[h], ecx>>1, ecx+[y], [y]=ecx, [h]=1
.else.if [o]='u'
  let eax=[y], [first]=eax, eax+[h], [last]=eax,\
   ecx=[w], ecx>>1, ecx+[x], [x]=ecx, [w]=1
.else.if [o]='r'
  let eax=[x], [first]=eax, eax+[w], [last]=eax
.else.if [o]='d'
  let eax=[y], [first]=eax, eax+[h], [last]=eax
.else.if [o]='ul'
  let ecx=[y], [first]=ecx, ecx+[h], [last]=ecx
.else.if [o]='ur'
  let ecx=[y], [first]=ecx, ecx+[h], [last]=ecx
.else.if [o]='dr'
  let ecx=[x], ecx+[w], [x]=ecx, ecx=[y],\
   [first]=ecx, ecx+[h], [last]=ecx, [w]=1
.else.if [o]='dl'
  let ecx=[y], [first]=ecx, ecx+[h],\
   [last]=ecx, [w]=1
.end
.loop [i]=[first] to [last]
  .if [o]='l'
    draw.line 'v', [i], [y], [h], [c]
  .else.if [o]='u'
    draw.line 'h', [x], [i], [w], [c]
  .else.if [o]='r'
    draw.line 'v', [i], [y], [h], [c]
  .else.if [o]='d'
    draw.line 'h', [x], [i], [w], [c]
  .else.if [o]='ul'
    draw.line 'h', [x], [i], [w], [c]
  .else.if [o]='ur'
    draw.line 'h', [x], [i], [w], [c]
  .else.if [o]='dr'
    draw.line 'h', [x], [i], [w], [c]
  .else.if [o]='dl'
    draw.line 'h', [x], [i], [w], [c]
  .end
  .if [i]&1
    .if [o]='l'
      let [y]--, [h]+2
    .else.if [o]='u'
      let [x]--, [w]+2
    .else.if [o]='r'
      let [x]++, [y]++, [h]-2
    .else.if [o]='d'
      let [x]++, [w]-2
    .end
  .end
  .if [o]='ul'
    let [w]--
  .else.if [o]='ur'
    let [x]++, [w]--
  .else.if [o]='dr'
    let [x]--, [w]++
  .else.if [o]='dl'
    let [w]++
  .end
.endl
endf

; draw arrows in 8 directions.
; not customizable yet

function draw.arrow.star, box, n, c
draw.arrow 'ul', [box], [c]
move.box.r [box]
draw.arrow 'u', [box], [c]
move.box.r [box]
draw.arrow 'ur', [box], [c]
move.box.d [box]
move.box.l [box]
move.box.l [box]
draw.arrow 'l', [box], [c]
move.box.r [box]
; <center>
move.box.r [box]
draw.arrow 'r', [box], [c]
move.box.d [box]
move.box.l [box]
move.box.l [box]
draw.arrow 'dl', [box], [c]
move.box.r [box]
draw.arrow 'd', [box], [c]
move.box.r [box]
draw.arrow 'dr', [box], [c]
endf

; draw [<] or [>] or both. unfinished...

function draw.arrow.box, way, box, i, n, a, b, c
calla !draw.chrome, 'v', [box], [a], [b], [n]
create.box.inside g.box, [box], [i], [i]
draw.arrow [way], g.box, [c]
endf

function draw.lever, box, n, d, a, b, c
draw.arrow.box 'l', [box], [n], [d], [a], [b], [c]
move.box.r [box]
move.box.right [box], 1
draw.arrow.box 'r', [box], [n], [d], [a], [b], [c]
endf

; draw line with dashes in 2 colors, w1 pixels
; of c1 then w2 pixels of c2

function draw.line.dash, o, x, y, n, c1, c2, w1, w2
locals i, w, dash, count
push esi edi
let eax=&[x], edx=&[y], ecx=&[n]
clip.line [o], eax, edx, ecx
fail .e
vga.xy [x], [y]
let edi=eax,\
eax=[c1], [dash]=YES
.if [o] not 'v'
  let [w]=1
.else
  let [w]=[screen.w]
.end
let [count]=0
.loop [i]=0 to [n]     ; loop x/y to w/h
  let [count]++
  .if [dash]=YES
    let eax=[c1],\
    ecx=[w1]
    .if [count]=ecx
      let [dash]=NO,\
       [count]=0
    .end
  .else
    let eax=[c2],\
    ecx=[w2]
    .if [count]=ecx
      let [dash]=YES,\
       [count]=0
    .end
  .end
  let [edi]=eax,\      ; draw pixel
   ecx=[w],\
   edi=&[edi+ecx*4]    ; advance vga+(w*4)
.endl
.e:
pop edi esi
endf

; draw bound/band; a box with lines that
; have dashes. for selections and boundaries
; on any color background. example:

; draw.bound box, WHITE, BLACK, 4, 4

function draw.bound, box, c1, c2, w1, w2
locals x, y, w, h
let eax=[box],\
 [x]=[?box.x+eax], [y]=[?box.y+eax],\
 [w]=[?box.w+eax], [h]=[?box.h+eax]
try visible [x], [y], [w], [h]
draw.line.dash 'h',\
 [x], [y], [w], [c1], [c2], [w1], [w2]
let eax=[y], eax+[h], eax-1
draw.line.dash 'h',\
 [x], eax, [w], [c1], [c2], [w1], [w2]
let eax=[y], eax+1, ecx=[h], ecx-2
draw.line.dash 'v',\
 [x], eax, ecx, [c1], [c2], [w1], [w2]
let eax=[x], eax+[w], eax-1,\
 edx=[y], edx+1, ecx=[h], ecx-2
draw.line.dash 'v',\
 eax, edx, ecx, [c1], [c2], [w1], [w2]
endf

; draw resizeable bounding box with 8
; small 8x8 squares on each corner and side

function draw.bound.x, box
locals wd2, hd2, b
draw.bound [box], WHITE, BLACK, 4, 4
let eax=[box],\
 ecx=[?box.w+eax], ecx>>1, [wd2]=ecx,\
 edx=[?box.h+eax], edx>>1, [hd2]=edx
copy.box g.box, [box]
nudge.box g.box, -4, -4
size.box g.box, 8, 8
let [b]=g.box
draw.box.bo [b], WHITE, BLACK
move.box.right [b], [wd2]
draw.box.bo [b], WHITE, BLACK
move.box.right [b], [wd2]
draw.box.bo [b], WHITE, BLACK
move.box.down [b], [hd2]
draw.box.bo [b], WHITE, BLACK
move.box.down [b], [hd2]
draw.box.bo [b], WHITE, BLACK
move.box.left [b], [wd2]
draw.box.bo [b], WHITE, BLACK
move.box.left [b], [wd2]
draw.box.bo [b], WHITE, BLACK
move.box.up [b], [hd2]
draw.box.bo [b], WHITE, BLACK
move.box.up [b], [hd2]
endf

; draw box with frame/window edge

; lt - lightest
; l  - light
; c  - medium. main color
; d  - dark
; dk - darkest

function draw.panel, box, lt, l, c, d, dk
locals x, y, w, h, r, b
let eax=[box],\
 [x]=[?box.x+eax], [y]=[?box.y+eax],\
 [w]=[?box.w+eax], [h]=[?box.h+eax]
try visible [x], [y], [w], [h]
let eax=[w], edx=[h],\
 ecx=[x], ecx+eax, [r]=ecx,\
 ecx=[y], ecx+edx, [b]=ecx
draw.box [x], [y], [w], [h], [c], 1
; draw main outline
let eax=[w], eax-1
draw.line 'h', [x], [y], eax, [l]
let eax=[h], eax-1
draw.line 'v', [x], [y], eax, [l]
let eax=[b], eax-1
draw.line 'h', [x], eax, [w], [l]
let eax=[r], eax-1
draw.line 'v', eax, [y], [h], [l]
; draw inner outline
let eax=[x], eax+1, ecx=[y], ecx+1,\
 edx=[w], edx-3
draw.line 'h', eax, ecx, edx, [lt]
let eax=[x], eax+1, ecx=[y], ecx+1,\
 edx=[h], edx-3
draw.line 'v', eax, ecx, edx, [lt]
let eax=[x], eax+1, ecx=[b], ecx-2,\
 edx=[w], edx-3
draw.line 'h', eax, ecx, edx, [dk]
let eax=[r], eax-2, ecx=[y], ecx+1,\
 edx=[h], edx-2
draw.line 'v', eax, ecx, edx, [dk]
; draw 2 inner shadow lines
let eax=[x], eax+2, ecx=[b], ecx-3,\
 edx=[w], edx-5
draw.line 'h', eax, ecx, edx, [l]
let eax=[r], eax-3, ecx=[y], ecx+2,\
 edx=[h], edx-4
draw.line 'v', eax, ecx, edx, [l]
endf

function draw.panel.c, box, c
locals lt, l, d, dk
get [lt]=lightness [c], 128
get [l]=lightness [c], 64
get [d]=lightness [c], -64
get [dk]=lightness [c], -128
draw.panel [box],\
 [lt], [l], [c], [d], [dk]
endf

; draw standard gray panel

macro draw.panel.g box {
draw.panel box,\
 WHITE, 808080h, 0E7E7E7h, 808080h, 404040h
}

; draw fade from color a to b by n/delta.
; o/rient: 'h'=horizontal, 'v'=vertical

function draw.fade, o, box, a, b, n
locals i, x, y, w, h, c, first, last
let eax=[box],\
[x]=[?box.x+eax], [y]=[?box.y+eax],\
[w]=[?box.w+eax], [h]=[?box.h+eax]
.if [o]='v'
  let eax=[y], [first]=eax,\
   eax+[h], [last]=eax
.else
  let eax=[x], [first]=eax,\
   eax+[w], [last]=eax
.end
let [c]=[a]
.loop [i]=[first] to [last]
  .if [o]='v' ; vertical fade, horizontal lines
    draw.line 'h', [x], [i], [w], [c]
  .else ; horizontal fade, vertical lines
    draw.line 'v', [i], [y], [h], [c]
  .end
  get [c]=mix [b], [c], [n]
.endl
endf

function draw.chrome, o, box, a, b, n
locals l
copy.box g.box, [box]
let [g.box.h]>>1
draw.fade 'v', g.box, [a], [b], [n]
move.box.down g.box, [g.box.h]
get [l]=lightness [b], 32
draw.fade 'v', g.box, [a], [l], [n]
draw.box.o [box], [l]
endf

macro draw.black.chrome box
{ draw.chrome 'v', box, BLACK, GRAY25, 16 }

macro draw.blue.chrome box
{ draw.chrome 'v', box, ROYAL.BLUE, BEACH.BLUE, 16 }

macro draw.red.chrome box
{ draw.chrome 'v', box, 0FF02010h, FIRE.RED, 16 }

macro draw.violet.chrome box
{ draw.chrome 'v', box, DARK.VIOLET, LILAC, 16 }

macro draw.alien.chrome box
{ draw.chrome 'v', box, 3D5310h, 0E4F737h, 16 }

; draw "scanline"; a multi-color horizontal line
; with optional transparent color key to exclude
; (or 0/none) and alpha (=0/opaque or 1-255).
; pixels parameter is the address of 32BPP pixel
; array. remaining parameters are integer by value.

; "alpha" applies to the entire image. for
; scanlines with alpha encoded in each pixel,
; see draw.scanline.a

function draw.scanline,\
 pixels, x, y, w, key, alpha
locals i
push esi edi
let eax=&[i], esi=&[x], edi=&[y], ecx=&[w]
clip.scanline eax, esi, edi, ecx
fail .r
vga.xy [esi], [edi]
let edi=eax, esi=[pixels], esi+[i], ecx=[w]

cmp [key], 0           ; if no key or alpha...
jnz .t
cmp [alpha], 0
jnz .t
rep movsd              ; use fast instruction
jmp .r
.t:                    ; else, loop copy
.loop [i]=0 to [w]     ; w # times
  let eax=[esi]        ; get pixel
  cmp eax, [key]       ; transparent?
  je .next             ; skip
  .if [alpha]          ; alpha?
    .if [alpha]=127    ; 50%? optimize
      let \
      edx=[edi],\
      edx&0FEFEFEh,\
      edx>>1,\
      eax=[esi],\
      eax&0FEFEFEh,\
      eax>>1, eax+edx
    .else
      mix eax, [edi],\ ; see COLOR>mix
      [alpha]
    .end
  .end
  let [edi]=eax        ; *vga++=*p++
  .next:
    let esi+4, edi+4
.endl
.r:
pop edi esi
endf

; draw "bitmap"; 2D pixel array. for key/alpha
; parameters, see draw.scanline. if image is
; completely invisible, this will return.
; if partially visible, draw.scanline will
; "clip"/exclude invisible sections (CLIP.INC)

function draw.bitmap, pixels,\
 x, y, w, h, key, alpha
locals p, i, iw, b
try visible [x], [y], [w], [h] ; visible?
let eax=[pixels], [p]=eax,\    ; p=pixels
ecx=[w], ecx<<2, [iw]=ecx,\    ; image w in bytes
ecx=[y], ecx+[h], [b]=ecx      ; bottom=y+h
.loop [i]=[y] to [b]           ; draw h # scanlines
  draw.scanline [p],\          ; from y to b
   [x], [i], [w],\
   [key], [alpha]
  let eax=[iw], [p]+eax        ; increment p by iw
.endl
endf

; draw 32BPP scanline with alpha (AA.RR.GG.BBh).

; * 0     - 100% visible/opaque
; * 1-254 - transparent
; * 255   - 100% invisible (a&0FF000000h=0)

function draw.scanline.a, pixels, x, y, w
locals i
push esi edi
let eax=&[i], esi=&[x], edi=&[y], ecx=&[w]
clip.scanline eax, esi, edi, ecx
fail .e
vga.xy [esi], [edi]
let edi=eax, esi=[pixels], esi+[i]

.loop [x]=0 to [w]      ; draw pixels
  let eax=[esi]         ; get pixel
  .if eax&0FF000000h    ; alpha?
    let ecx=eax
    shr ecx, 24
    .if ecx=0FFh        ; invisible
      jmp .next
    .end
    mix [edi], eax, ecx ; result in eax
  .end
  let [edi]=eax         ; *vga++=*p++
  .next:
  let esi+4, edi+4
.endl
.e:
pop edi esi
endf

; draw 32BPP bitmap with alpha (AA.RR.GG.BBh)

function draw.bitmap.a, pixels, x, y, w, h
locals p, i, iw, b
try visible \                ; visible?
 [x], [y], [w], [h]
let [p]=[pixels],\           ; p=pixels
 ecx=[w], ecx<<2, [iw]=ecx,\ ; image w in bytes
 ecx=[y], ecx+[h], [b]=ecx   ; bottom=y+h
.loop [i]=[y] to [b]         ; draw h # scanlines
  draw.scanline.a [p],\
   [x], [i], [w]
  let eax=[iw], [p]+eax      ; increment p by iw
.endl
endf

; draw a "variant scanline" that combines alpha
; intensity with a color

; p: pixel array, shades of black/gray/white.
; c=color. useful for drawing custom bitmap fonts
; with antialiased edges (FONT>draw.c) and
; artistic brushes

function draw.scanline.v, pixels, x, y, w, c
locals i
push esi edi
let eax=&[i], esi=&[x], edi=&[y], ecx=&[w]
clip.scanline eax, esi, edi, ecx
fail .e
vga.xy [esi], [edi]
let edi=eax,\
esi=[pixels],\
esi+[i]
.loop [i]=0 to [w] ; process pixels
  let eax=[c],\
  ecx=[esi],\      ; current pixel
  ecx&0FFh         ; alpha (R=G=B in grayscale)
  cmp ecx, 0       ; 100% invisible? (black)
  je .skip
  cmp ecx, 0FFh    ; 100% visible? (white)
  je .copy
  mix \            ; partially visible? (gray)
  eax, [edi], ecx
  .copy: stosd
    add esi, 4
    jmp .el
  .skip:
    let esi+4, edi+4
  .el:
.endl
.e:
pop edi esi
endf

; draw bitmap using variant scanline

function draw.bitmap.v, pixels, x, y, w, h, c
locals p, i, iw, b
try visible \                ; visible?
 [x], [y], [w], [h]
let eax=[pixels], [p]=eax,\  ; p=pixels
 ecx=[w], ecx<<2, [iw]=ecx,\ ; image w in bytes
 ecx=[y], ecx+[h], [b]=ecx   ; bottom=y+h
.loop [i]=[y] to [b]         ; draw h # scanlines
  draw.scanline.v [p],\
   [x], [i], [w], [c]
  let eax=[iw], [p]+eax      ; increment p by iw
.endl
endf

; OS-specific code to copy VGA/buffer
; to primary display...

include 'vga.inc'
    
Post 12 Nov 2012, 16:54
View user's profile Send private message Reply with quote
uart777



Joined: 17 Jan 2012
Posts: 369
IMAGE.INC

Code:
; $$$$$$$$$$$$$$$ Z77 ASM LIBRARY $$$$$$$$$$$$$$$$
; *************** SUNGOD SOFTWARE ****************
; ?????????????????? IMAGE.INC ???????????????????

include 'bmp.inc'
include 'tga.inc'

; create.image image, w, h
; destroy.image image

; set.image.pixels image, p
; get.image.pixels image, p

; load.image image, file
; save.image image, file

; draw.image image
; draw.image.at image, x, y
; size.image image, w, h
; size.image.p image, p
; move.image image, x, y
; center.image image
; align.image image, b, a
; collide.image image.a, image.b

; set.image.key image
; set.image.alpha image, a
; convert.image.alpha image, source

; image.light image, n
; image.grayscale image
; image.color image, c, n
; image.invert image
; image.channel image, c

macro IMAGE.X {
 VOID p
 NUMBER x, y, w, h, bpp=32
 COLOR key, alpha
}

STRUCTURE IMAGE
 IMAGE.X
ENDS ?image

?image.box equ ?image.x

TEXT image.folder='IMAGE\',\
image.ext='.BMP', image.wild='*.BMP'

VOID load.bitmap=!load.bmp,\
save.bitmap=!save.bmp

; note: image.p/ixels are stored logically,
; ARGB32; images are NOT upside down, colors
; are NOT backwards and there are NO pointless
; "junk bytes" after each row. images can be
; processed much faster with linear pixels

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

function create.image, image, w, h
locals p, n
let eax=[image], [p]=[?image.p+eax],\
 ecx=[w], ecx<<2, ecx*[h], [n]=ecx
allocate.x [p], [n]
fail .error
let eax=[image], [?image.p+eax]=[p],\
 [?image.w+eax]=[w], [?image.h+eax]=[h],\
 [?image.bpp+eax]=32
jmp @f ; return image address
.error: let eax=0
@@:
endf

function destroy.image, image
let eax=[image], eax=[?image.p+eax]
.if true
  destroy eax
  memory.zero [image], IMAGE.$
.end
endf

function set.image.pixels, image, p
let eax=[image],\
 ecx=[?image.w+eax], edx=[?image.h+eax],\
 ecx*edx, ecx<<2
memory.copy [?image.p+eax], [p], ecx
endf

function get.image.pixels, image, p
let eax=[image],\
 ecx=[?image.w+eax], edx=[?image.h+eax],\
 ecx*edx, ecx<<2
memory.copy [p], [?image.p+eax], ecx
endf

function copy.image, a, b
destroy.image [a]
let eax=[b]
create.image [a],\
 [?image.w+eax], [?image.h+eax]
let eax=[b], eax=[?image.p+eax]
set.image.pixels [a], eax
endf

function load.image, image, file
locals p
try calla [load.bitmap], [file]
let [p]=eax,\
eax=[image], [?image.p+eax]=[p],\
[?image.w+eax]=ecx, [?image.h+eax]=edx
endf

macro set.image.key image {
let eax=image, ecx=[?image.p+eax],\
[?image.key+eax]=[ecx]
}

macro load.image.t image, file {
load.image image, file
set.image.key image
}

macro load.images [p] {
forward make.txt eax, 'IMAGE\'#`p#'.BMP'
load.image p#.i, eax
set.image.key p#.i
}

function save.image, image, file, bpp
let eax=[image]
calla [save.bitmap], [file], [?image.p+eax],\
[?image.w+eax], [?image.h+eax], [bpp]
endf

macro set.image.alpha image, a {
let eax=image, [?image.alpha+eax]=a
}

; draw pixel array. see DRAW.INC

function draw.image, image
let eax=[image]
draw.bitmap [?image.p+eax],\
 [?image.x+eax], [?image.y+eax],\
 [?image.w+eax], [?image.h+eax],\
 [?image.key+eax], [?image.alpha+eax]
endf

macro draw.image.at image, x, y {
move.image image, x, y
draw.image image
}

function draw.image.box, image
let eax=[image], edx=&[?image.box+eax]
draw.bitmap [?image.p+eax],\
 [?box.x+edx], [?box.y+edx],\
 [?image.w+eax], [?image.h+eax],\
 [?image.key+eax], [?image.alpha+eax]
endf

function draw.image.a, image, box, a
let eax=[image], eax+?image.box
align.box eax, [box], [a]
endf

macro draw.images [images]
{ forward calla !draw.image, images }

; draw image with 32BBP alpha. image.alpha
; applies to the entire image whereas this
; allows each pixel to have variable alpha.
; if image has no alpha or key, standard
; "draw.image" is faster (rep movsd)

function draw.image.alpha, image
let eax=[image]
draw.bitmap.a [?image.p+eax],\
 [?image.x+eax], [?image.y+eax],\
 [?image.w+eax], [?image.h+eax]
endf

function move.image, image, x, y
let eax=[image], [?image.x+eax]=[x],\
[?image.y+eax]=[y]
endf

function center.image, image
let eax=[image], eax+?image.box
center.b eax
endf

; convert 32BPP image to alpha based on a
; grayscale source image (c&BLUE=alpha since
; R=G=B in B/W). to reverse B/W, use
; "image.invert" before and/or after

; destiny|=((source&BLUE)<<24)

function convert.image.alpha, image, source
push esi edi
let esi=[source], esi=[?image.p+esi],\
 edi=[image], eax=edi, edi=[?image.p+edi],\
 ecx=[?image.w+eax], edx=[?image.h+eax], ecx*edx
.convert:
 let eax=[esi], eax&0FFh, eax<<24,\
 [edi]|eax, edi+4, esi+4, ecx--
jnz .convert
pop edi esi
endf

; does color exist in palette? return index
; or -1. colors are AA.RR.GG.BB

function color.exists, palette, c, bpp
locals i, n
let eax=1, ecx=[bpp],\
eax<<cl, [n]=eax
.loop [i]=0 to [n]
  let eax=[palette], ecx=[i],\
  edx=[eax+ecx*4]
  .if [c]=edx
    return [i]
  .end
.endl
let eax=-1
endf

macro .if.unique.color p, c, b {
color.exists p, c, b
.if eax=-1
}

; draw image from 2D graph of images - for
; sprites, projectiles, explosions, etc.
; cell is drawn at image.x/y. parameters
; x/y = cell offset inside image.
; w/h = cell size

function draw.image.cell, image, x, y, w, h
locals i, p, ix, iy, iw, ih, wb, b, key
let eax=[image],\
 [ix]=[?image.x+eax], [iy]=[?image.y+eax],\
 [iw]=[?image.w+eax], [ih]=[?image.h+eax],\
 [p]=[?image.p+eax], [key]=[?image.key+eax]
; image w in bytes
let eax=[iw], eax<<2, [wb]=eax
; p=&image[(iw*h*y*4)+(x*w*4)]
let eax=[iw], eax*[h], eax*[y], eax<<2,\
 ecx=[x], ecx*[w], ecx<<2, eax+ecx,\
 eax+[p], [p]=eax, ecx=[iy], ecx+[h], [b]=ecx
.loop [i]=[iy] to [b]
  draw.scanline [p], [ix], [i], [w], [key], 0
  let ecx=[p], ecx+[wb], [p]=ecx
.endl
endf

; create "scratchpad"; temporary image
; for size, mirror, rotate, effects.
; return [image.p] pixels address

align 8
IMAGE scratch.i

function scratch, w, h
try create.image scratch.i, [w], [h]
let eax=[scratch.i.p]
endf

; when finished with scratchpad, use this to
; copy its pixels to image then deallocate it

macro end.scratch image {
copy.image image, scratch.i
destroy.image scratch.i
}

; size pixel array using "nearest neighbor"
; (accurate, interpolation is not). remember
; to backup original image:

; copy.image backup.i, original.i

function size.image, image, w, h
locals i, j, p, s, x1, y1, w1, h1, x2, y2
let eax=[image], [s]=[?image.p+eax],\
 [w1]=[?image.w+eax], [h1]=[?image.h+eax]
try [p]=scratch [w], [h]
; ratio=(size<<16)/size
let eax=[w1], eax<<16, eax/[w], [x1]=eax,\
 eax=[h1], eax<<16, eax/[h], [y1]=eax
.loop [i]=0 to [h]
  .loop [j]=0 to [w]
    ; offset=(n*ratio)>>16
    let eax=[j], eax*[x1], eax>>16, [x2]=eax,\
     eax=[i], eax*[y1], eax>>16, [y2]=eax
    ; destiny[(i*w2)+j]=source[(y2*w1)+x2]
    let eax=[i], eax*[w], eax+[j], eax<<2,\
     eax+[p], ecx=[y2], ecx*[w1], ecx+[x2],\
    ecx<<2, ecx+[s], [eax]=[ecx] ; *p=*s
  .endl
.endl
end.scratch [image]
endf

; size by percentage (integer)

function size.image.p, image, p
locals w, h, iw, ih
let eax=[image],\
 [iw]=[?image.w+eax], [ih]=[?image.h+eax],\
 eax=[iw], eax*[p], ecx=100, eax/ecx, [w]=eax,\
 eax=[ih], eax*[p], ecx=100, eax/ecx, [h]=eax
size.image [image], [w], [h]
endf

; mirror; flip 'h'orizontal, 'v'ertical
; or 'd'iagonal

function mirror.image.h, image
locals x, y, w, h, p, s
let eax=[image], [s]=[?image.p+eax],\
 [w]=[?image.w+eax], [h]=[?image.h+eax]
try [p]=scratch [w], [h]
.loop [y]=0 to [h]
  .loop [x]=0 to [w]
    ; p[x+(y*w)]=s[(w-x-1)+(y*w)]
    let edx=[w], edx-[x], edx-1, ecx=[y],\
    ecx*[w], edx+ecx, edx<<2, edx+[s],\
    eax=[x], eax+ecx, eax<<2, eax+[p],\
    [eax]=[edx]
  .endl
.endl
end.scratch [image]
endf

function mirror.image.v, image
locals x, y, w, h, p, s
let eax=[image], [s]=[?image.p+eax],\
 [w]=[?image.w+eax], [h]=[?image.h+eax]
try [p]=scratch [w], [h]
.loop [y]=0 to [h]
  ; memory.copy &p[y*w], &s[(h-y-1)*w], w*4
  let edx=[h], edx-[y], edx-1, edx*[w],\
  edx<<2, edx+[s], eax=[y], eax*[w],\
  eax<<2, eax+[p], ecx=[w], ecx<<2
  memory.copy eax, edx, ecx
.endl
end.scratch [image]
endf

function mirror.image, image, way
.if [way]='h'
  mirror.image.h [image]
.else.if [way]='v'
  mirror.image.v [image]
.else.if [way]='d'
  mirror.image.h [image]
  mirror.image.v [image]
.end
endf

function align.i, image, a
let eax=[image], eax+?image.box
align.b eax, [a]
endf

function align.image, image, box, a
let eax=[image], eax+?image.box
align.box eax, [box], [a]
endf

function draw.image.align, image, box, a
align.image [image], [box], [a]
draw.image [image]
endf

function collide.image, a, b
let eax=[a], eax+?image.box,\
edx=[b], edx+?image.box
collide.box eax, edx
endf

macro .if.select.image i { .if.select i#.x }

;;;;;;;;;;;;;;;; IMAGE OPERATIONS ;;;;;;;;;;;;;;;

; an "operation" is a function that contains a
; loop that processes the current pixel of an
; image. scroll down to see how useful this is

macro operation name, [ps] {
common function name, ps
locals i, iw, p
let eax=[image], ecx=[?image.p+eax],\
 [p]=ecx, ecx=[?image.w+eax]
imul ecx, [?image.h+eax]
let [iw]=ecx
.loop [i]=0 to [iw]     ; scroll image pixels
  let eax=[image],\
   eax=[?image.key+eax]
  test eax, eax         ; if transparent
  jz @f
  let ecx=[p]           ; current pixel
  cmp [ecx], eax        ; =key? end loop
  je .el
  @@:
  let eax=[p]
}

macro endo {
  let ecx=[p], [ecx]=eax
  .el:
  add [p], 4
.endl
endf
}

; with previous macros, one can easily
; create/edit multiple image effects.
; see COLOR>operations

operation image.light, image, n
lightness [eax], [n]
endo

operation image.grayscale, image
grayscale [eax]
endo

operation image.color, image, c, n
colorize [eax], [c], [n]
endo

operation image.invert, image
inversion [eax]
endo

operation image.channel, image, c
channelize [eax], [c]
endo

purge operation, endo

;;;;;;;;;;;;;;;;;;; SCREENSHOT ;;;;;;;;;;;;;;;;;;;

; save vga/screen as image file. this is slow
; due to repetitive read/write API calls for
; each pixel. just one 1024x768x32 screen is
; 786,432*4 = 3,145,728 bytes!

function screenshot, file
calla [save.bitmap], [file], [vga],\
[screen.w], [screen.h], 24
endf
    
Post 12 Nov 2012, 16:55
View user's profile Send private message Reply with quote
uart777



Joined: 17 Jan 2012
Posts: 369
FONT.INC

Code:
; $$$$$$$$$$$$$$ Z77 ASM LIBRARY $$$$$$$$$$$$$$$$$
; ************** SUNGOD SOFTWARE *****************
; ?????????????????? FONT.INC ????????????????????

; get.font f       ; get current font
; set.font f       ; set font style
; set.font.color c ; set font color
; set.font.c f, c  ; set style and color
; load.font/s...   ; load image/s to font/s
; load.all.fonts   ; from /FONT/ to fonts array

; destroy.font f
; backup.font
; restore.font

; draw.c c, x, y      ; draw 'c'haracter
; draw.c.a c, x, y    ; aligned in box
; draw.text t, x, y   ; draw 'text'
; draw.text.a t, b, a ; aligned in box

; text.w/h get the exact size of single or
; multi-line text in the current font. example:
; if font.w=20, text.w('ABC') will return 60.
; text.width/height get the size of text with
; insets applied: font.w/2, font.h/4.
; make.text.box creates a box that is the size
; of text with insets

; text.w t
; text.h t
; text.width t
; text.height t
; make.text.box t, box

; draw.caption t, x, y
; draw.caption.x t, x, y, style, c, fc, lc
; draw.caption.a t, a
; draw.caption.align t, box, a

; set.colors c, fc, lc
; set.graphics g
; set.justify j
; backup.theme
; restore.theme

STRUCTURE FONT ; custom bitmap font
 TEXT name(32) ; example: "Console"
 NUMBER type   ; FT_x
 NUMBER w, h   ; glyph size. example: 16x24
 COLOR color
 IMAGE image   ; glyph images
ENDS ?font

powers FT_MONOSPACE, FT_VARIABLE, FT_RASTER,\
FT_IMAGE, FT_TEXTURE, FT_GRADIENT, FT_ALPHA
numeric FT_DEFAULT=FT_MONOSPACE+FT_RASTER

align 8
FONT font, font.backup
TEXT font.folder='FONT\',\
font.ext='.BMP', font.wild='*.BMP'

;;;;;;;;;;;;;;;;;;; SYMBOLS ;;;;;;;;;;;;;;;;;;;;;;

; my default character arrangement: 95 symbols.
; includes all standard visible characters

; 0 1 2 3 4 5 6 7 8 9 A B C D E F G H I
; J K L M N O P Q R S T U V W X Y Z a b
; c d e f g h i j k l m n o p q r s t u
; v w x y z _   . ? ; : ' " , ~ ! @ # $
; % ^ & * ( ) [ ] { } = + - < > / \ | `

; symbol lookup table to convert 7BIT ASCII
; character to index. 63=ignore (spaces, etc)

N_SYMBOLS=95
FONT_SYMBOLS: db \
63,63,63,63,63,63,63,63, 63,63,63,63,63,63,63,63,\
63,63,63,63,63,63,63,63, 63,63,63,63,63,63,63,63,\
63,72,69,74,75,76,78,68, 80,81,79,87,70,88,64,91,\
00,01,02,03,04,05,06,07, 08,09,67,66,89,86,90,65,\
73,10,11,12,13,14,15,16, 17,18,19,20,21,22,23,24,\
25,26,27,28,29,30,31,32, 33,34,35,82,92,83,77,62,\
94,36,37,38,39,40,41,42, 43,44,45,46,47,48,49,50,\
51,52,53,54,55,56,57,58, 59,60,61,84,93,85,71,63

;;;;;;;;;;;;;;; GET/SET FONT/COLOR ;;;;;;;;;;;;;;;

function get.font, f
memory.copy [f], font, FONT.$
endf

function set.font, f
push [font.color]
memory.copy font, [f], FONT.$
pop [font.color]
endf

function set.font.c, f, c
memory.copy font, [f], FONT.$
let [font.color]=[c]
endf

macro set.font.color c { let [font.color]=c }

function destroy.font, f
let eax=[f]
destroy [?font.image.p+eax]
endf

macro backup.font { get.font font.backup }
macro restore.font { set.font font.backup }

;;;;;;;;;;;;;;; LOAD BITMAP FONT ;;;;;;;;;;;;;;;;;

; font.w=image.w/N_SYMBOLS, font.h=image.h (same)

function load.font, font, file
locals name, image, w, h
let eax=[font],\
ecx=&[?font.name+eax], [name]=ecx,\
ecx=&[?font.image+eax], [image]=ecx
text.copy [name], [file]
remove.ext [name]
text.upper [name]
!if load.image, [image], [file] ; returns w/h
  let [w]=ecx, [h]=edx, eax=ecx,\ ; in ecx/edx
  ecx=N_SYMBOLS, eax/ecx, ecx=[font],\
  [?font.w+ecx]=eax, [?font.h+ecx]=[h]
  set.image.key [image]
.end
set.font.c [font], WHITE
endf

; load fonts by name

macro load.fonts [p] {
forward
make.txt eax, 'FONT\'#`p#'.BMP'
load.font p#.f, eax
}

;;;;;;;;;;;;;;;;;; SYSTEM FONTS ;;;;;;;;;;;;;;;;;;

macro define.system.fonts {
FONT text.f, text2.f,\
code1.f, code2.f, code3.f, code4.f, code5.f,
console.f, console2.f,\
type.f, type2.f
}

macro load.system.fonts {
load.fonts text, text2,\
code1, code2, code3, code4, code5,
console, console2,\
type, type2
}

;;;;;;;;;;;;;;;;;; FONT ARRAY ;;;;;;;;;;;;;;;;;;;;

align 8
ARRAY _fonts(FONT.$), _font.files(1*KB)
NUMBER font.index

; create dynamic array of FONT structures then
; load all fonts from \FONT\. this may be
; located in the current directory or 1-2 higher
; directories for all projects to share

function load.all.fonts
locals i, p
let [font.index]=0
try where.is font.folder ; get filenames
try find.files _font.files, font.wild
.loop [i]=0 to [_font.files.n] ; load images
  @index [p]=_font.files[i]
  @expand _fonts
  load.font eax, [p]
.endl
reset.directory
let eax=[_fonts]
endf

; set.font i - set current font by index

function set.font.i, i
@index _fonts[i]
set.font eax
let [font.index]=[i]
endf

; get font name by index

function get.font.name, i
@index _fonts[i]
let eax+?font.name
endf

; get font index by name or return -1
; if doesn't exist

function get.font.i, name
locals i
.loop [i]=0 to [_fonts.n]
  @index _fonts[i]
  let eax+?font.name
  .if.text.equal name, eax
    return [i]
  .end
.endl
let eax=-1
endf

function destroy.fonts
locals i
.loop [i]=0 to [_fonts.n]
  @index _fonts[i]
  destroy.font eax
.endl
endf

;;;;;;;;;;;;;;;;; DRAW CHARACTER ;;;;;;;;;;;;;;;;;

; the heart of all draw text functions

; draw.c 'Z', 1, 1

function draw.c, ch, x, y
locals p, iw, i, n
let eax=FONT_SYMBOLS, eax+[ch]
cmp byte [eax], 63 ; invisible?
je .!
try visible [x], [y], [font.w], [font.h]

; p=&image[symbols[ch]*font.w*4]

let eax=FONT_SYMBOLS, eax+[ch],\
eax=>[eax], eax*[font.w], eax<<2,\
eax+[font.image.p], [p]=eax,\
[iw]=[font.image.w], [iw]<<2

; draw font.h # scanlines

.loop [i]=0 to [font.h]
  let ecx=[y], ecx+[i]
  draw.scanline.v [p], [x], ecx,\
  [font.w], [font.color]
  let ecx=[p], ecx+[iw], [p]=ecx
.endl
let eax=[draw.c.p]
endf

; current draw character function pointer.
; just redefine this for custom gradients
; and textures

align 8
VOID draw.c.p=!draw.c

function set.draw.c, a
let [draw.c.p]=[a]
endf

;;;;;;;;;;;;;;;;;;; DRAW TEXT ;;;;;;;;;;;;;;;;;;;;

; draw.text.t 'SunGod Software', 1, 1

function draw.text, t, x, y
locals i, n, p
let eax=[t],\
[p]=eax, [i]=0
.while byte [eax]      ; draw all characters
  let ecx=[i],\        ; x=i*font.w+x
   ecx*[font.w],\
   ecx+[x], eax=[p],\  ; get c
   eax=>[eax]
  .if eax=0Dh          ; return?
    let [i]=0,\        ; reset x
     ecx=[font.h],\
     [y]+ecx, [p]++,\  ; y+font.h
     [i]=0
    jmp .next
  .end
  let edx=[y],\        ; get y+font.h
   edx-[font.h]
  cmp edx, [screen.h]  ; off screen?
  jg .!                ; return
  calla [draw.c.p],\   ; draw character
  eax, ecx, [y]
  let [i]++
  .next:
  let [p]++, eax=[p]   ; eax=p for while
.endw
endf

; literal 'text' version

macro draw.text.t t, x, y {
make.txt eax, t
draw.text eax, x, y
}

; set color then draw text

macro draw.text.c t, x, y, c {
set.font.color c
draw.text t, x, y
}

;;;;;;;;;;;;;;;;; TEXT/BOX SIZE ;;;;;;;;;;;;;;;;;;

; get width of 'text' in characters. if single
; line, w = text length. if multi-line, w =
; longest line

function text.wc, t
locals p, s, n, gw
let [p]=[t], eax=[t]
.if byte [eax]=0     ; no text
  return 0
.end

; which line has the greatest width?

let [gw]=0
.line:               ; get line
let [s]=[p]
get [p]=text.find \  ; find first/next 0Dh
[p], 0Dh
.if true             ; multi-line?
  let eax-[s],\      ; length
   [n]=eax, [p]+2
.else                ; single or last line?
  get [n]=text.n [s] ; length = until 0
.end
let ecx=[n]
.if ecx>[gw]         ; greatest width?
  let [gw]=ecx
.end
.if [p]              ; more lines?
  jmp .line
.end
let eax=[gw]
endf

; get height in characters or # lines

function text.hc, t
locals n, p
let [n]=0,\
 eax=[t], [p]=eax
.if not byte [eax]    ; no lines
  let eax=0
  escape
.end
.while [p]
  let [n]++           ; 1+ lines
  get [p]=text.find \
  [p], 0Dh
  .if true
    let [p]+2
  .end
.endw
let eax=[n]
endf

; get exact size in pixels of single or
; multi-line 'text' in current font.
; w=longest.line*font.w. h=n.lines*font.h

function text.w, t
text.wc [t]
let eax*[font.w]
endf

function text.h, t
text.hc [t]
let eax*[font.h]
endf

; return exact size in memory variables.
; w/h are sent by reference

function text.size, t, w, h
text.w [t]
push eax
text.h [t]
pop ecx
let edx=[w], [edx]=ecx,\
 edx=[h], [edx]=eax
endf

; get text insets: font.w/2, font.h/4

function text.ix
let eax=[font.w], eax>>1
endf

function text.iy
let eax=[font.h], eax>>2
endf

; return insets in memory variables. x/y are
; sent by reference

function text.insets, x, y
text.ix
let ecx=[x], [ecx]=eax
text.iy
let ecx=[y], [ecx]=eax
endf

; get size of 'text' with insets applied:
; w*font.w+(inset.x*2), h*font.h+(inset.y*2)

function text.width, t
text.wc [t]
let ecx=[font.w], eax*ecx, eax+ecx
endf

function text.height, t
text.hc [t]
let ecx=[font.h], eax*ecx, ecx>>1, eax+ecx
endf

; size of character with insets

function font.width
let eax=[font.w], ecx=eax, ecx>>1, eax+ecx
endf

function font.height
let eax=[font.h], ecx=eax, ecx>>2, eax+ecx
endf

; return box size in memory variables.
; w/h are sent by reference

function text.box.size, t, w, h
text.width [t]
push eax
text.height [t]
pop ecx
let edx=[w], [edx]=ecx,\
 edx=[h], [edx]=eax
endf

; create box to contain text with insets.
; used by draw.caption/x and controls

function make.text.box, t, box
text.width [t]
push eax
text.height [t]
pop ecx
let edx=[box],\
 [?box.w+edx]=ecx, [?box.h+edx]=eax
endf

; create box based on width in characters

function make.text.box.w, box, w
let eax=[box],\
 ecx=[w], edx=[font.w], ecx*edx, ecx+edx,\
 [?box.w+eax]=ecx,\
 ecx=[h], edx=[font.h], ecx*edx, edx>>1,\
 ecx+edx, [?box.h+eax]=ecx
endf

; text is considered "multi-line" if
; it contains at least one 0Dh, 2+ lines.
; any beginning or ending returns should be
; removed in non-editable graphic text

macro is.multi.line t { text.find t, 0Dh }

; get greatest w in literal text array

function text.array.w, ta, n
locals i, w
let [w]=0
.loop [i]=0 to [n]
  let eax=[ta], ecx=[i]
  text.w [eax+ecx*4]
  .if eax>[w]
    let [w]=eax
  .end
.endl
let eax=[w]
endf

;;;;;;;;;;; DRAW C/TEXT WITH ALIGNMENT ;;;;;;;;;;;

; draw c/text aligned inside of BOX (x/y/w/h).
; see BOX.INC alignment values: CENTER_X/Y,
; ALIGN_C/L/T/R/B/N/NE/E/SE/S/SW/W/NW, JUSTIFY_L/R

BOX c.box, t.box

function draw.c.a, c, b, a
make.box c.box, [font.w], [font.h]
align.box c.box, [b], [a]
draw.c [c], [c.box.x], [c.box.y]
endf

function draw.text.a, t, b, a
text.size [t], t.box.w, t.box.h
align.box t.box, [b], [a]
draw.text [t], [t.box.x], [t.box.y]
endf

function draw.text.in, t, b, a, nx, ny
text.size [t], t.box.w, t.box.h
align.box t.box, [b], [a]
nudge.box t.box, [nx], [ny]
draw.text [t], [t.box.x], [t.box.y]
endf

macro draw.text.t t, x, y {
make.txt eax, t
draw.text eax, x, y
}

macro draw.text.center t, b
{ draw.text.align t, b, CENTER }

;;;;;;;;;;;;;;;;;;;;; THEME ;;;;;;;;;;;;;;;;;;;;;;

macro THEME.X {
NUMBER graphics ; G_x style
FONT font
COLOR color,\
line.color,\
shade.color
NUMBER justify
}

STRUCTURE THEME
 THEME.X
ENDS

ASSUME ?theme=THEME

align 4
THEME theme, theme.backup

macro set.colors c, fc, lc {
let [theme.color]=c, [theme.font.color]=fc,\
 [theme.line.color]=lc
}

macro set.default.colors
{ set.colors BLACK, WHITE, GRAY }

macro set.graphics g { let [theme.graphics]=g }
macro set.justify j { let [theme.justify]=j }

function backup.theme
memory.copy theme.backup, theme, THEME.$
let eax=theme, ecx=theme.backup
endf

function restore.theme
memory.copy theme, theme.backup, THEME.$
endf

;;;;;;;;;;;;;;;;;;;; CAPTION ;;;;;;;;;;;;;;;;;;;;;

; "[Caption]"; a box/frame that contains text
; with insets and is drawn according to the
; current "theme"

align 4
BOX ca.box, ct.box
NUMBER _caption.w, _caption.h ; if G_STATIC

function set.caption.size, w, h
let [_caption.w]=[w], [_caption.h]=[h]
endf

function draw.caption, t, x, y
locals i, n, p,\
w, h, ix, iy, graphics, justify
let [graphics]=[theme.graphics],\
 [justify]=[theme.justify]

.if not [graphics] ; default
  set.graphics (G_DYNAMIC+G_COLOR+G_LINE+G_TEXT)
  let [graphics]=[theme.graphics]
.end
.if not [theme.justify]
  set.justify CENTER
  let [justify]=[theme.justify]
.end
.if [graphics]&G_STATIC ; get box size
  let [w]=[_caption.w], [h]=[_caption.h]
.else.if [graphics]&G_DYNAMIC
  let eax=&[w], ecx=&[h]
  text.box.size [t], eax, ecx
.end
.if [graphics]&G_COLOR ; draw box?
  draw.box [x], [y], [w], [h],\
   [theme.color], YES
.end
.if [graphics]&G_LINE ; outline?
  draw.box [x], [y], [w], [h],\
   [theme.line.color], NO
.end
.if.n [graphics]&G_TEXT ; text?
  escape ; no? return
.end

; create box to contain text
let eax=&[ix], edx=&[iy] ; size of text+insets
text.insets eax, edx
create.box ca.box, [x], [y], [w], [h]
create.box.inside ct.box, ca.box, [ix], [iy]
set.font.color [theme.font.color]
get [n]=text.hc [t]
let [p]=[t]

.loop [i]=0 to [n] ; draw each row/line...
  let eax=[p],\
  edx=[?t]         ; copy until return
  @@:
  let ecx=>[eax]
  test ecx, ecx    ; or 0
  jz @f
  cmp ecx, 0Dh
  je @f
  let cl=[eax], [edx]=cl, eax++, edx++
  jmp @b
  @@:

  ; draw text aligned horizontally...
  let eax+2, [p]=eax, byte [edx]=0
  create.box ca.box, [ct.box.x], [ct.box.y],\
   [ct.box.w], [font.h]
  let eax=[font.h], [ct.box.y]+eax,\ ; move down
   eax=[ca.box.x], ecx=[ca.box.y]
  draw.text.a [?t], ca.box, [justify]
.endl
endf

; draw "[Caption]" in specified style and colors

function draw.caption.x, t, x, y, style, c, fc, lc
.if not [style] ; default
  let [style]=(G_DYNAMIC+G_COLOR+G_LINE+G_TEXT)
.end
set.graphics [style]
set.colors [c], [fc], [lc]
draw.caption [t], [x], [y]
endf

; draw "[Caption]" aligned relative to
; the screen

function draw.caption.s, t, a
make.text.box [t], ca.box
align.b ca.box, [a]
draw.caption [t], [ca.box.x], [ca.box.y]
endf

; draw "[Caption]" aligned inside of
; another box with optional nudge x/y

function draw.caption.a, t, b, a
make.text.box [t], ca.box
align.box ca.box, [b], [a]
draw.caption [t], [ca.box.x], [ca.box.y]
endf

function draw.caption.in, t, b, a, nx, ny
make.text.box [t], ca.box
align.box ca.box, [b], [a]
nudge.box ca.box, [nx], [ny]
draw.caption [t], [ca.box.x], [ca.box.y]
endf
    
Post 12 Nov 2012, 16:55
View user's profile Send private message Reply with quote
uart777



Joined: 17 Jan 2012
Posts: 369
Image
Post 12 Nov 2012, 16:57
View user's profile Send private message Reply with quote
JohnFound



Joined: 16 Jun 2003
Posts: 3494
Location: Bulgaria
uart777, isn't it better to pack these files to .zip file and to publish them this way? Together with explanation what is this and how to use it.
Post 12 Nov 2012, 16:57
View user's profile Send private message Visit poster's website ICQ Number Reply with quote
uart777



Joined: 17 Jan 2012
Posts: 369
JohnFound: Sorry. I intended to do that, but my hard drives went out Sad

Any questions? Please ask. "vga" is a linear 32BPP pixel array.
Post 12 Nov 2012, 16:58
View user's profile Send private message Reply with quote
uart777



Joined: 17 Jan 2012
Posts: 369
Code:
; clear screen. copy w*h # dwords

function clear.screen
push edi
let edi=[vga], eax=[screen.color],\
ecx=[screen.w], ecx*[screen.h]
rep stosd
pop edi
endf
    
Post 12 Nov 2012, 17:06
View user's profile Send private message Reply with quote
uart777



Joined: 17 Jan 2012
Posts: 369
By the way, here's the oldest code I could find. Written in MASM in 97':

Code:
; MASM DirectX example

.386
.model flat, stdcall
option casemap: none

includelib \masm32\lib\user32.lib
includelib \masm32\lib\gdi32.lib
includelib \masm32\lib\kernel32.lib
includelib \masm32\lib\winmm.lib
includelib \masm32\lib\ddraw.lib
includelib \masm32\lib\dsound.lib
include \masm32\include\windows.inc
include \masm32\include\kernel32.inc
include \masm32\include\user32.inc
include \masm32\include\gdi32.inc
include \masm32\include\winmm.inc
include \masm32\include\ddraw.inc
include \masm32\include\dsound.inc

callp equ invoke

; IDirectDraw interface method offsets
DDRELEASE             equ 8
DDBLT                 equ 20
DDCREATESURFACE       equ 24
DDFLIP                equ 44
DDGETATTACHEDSURFACE  equ 48
DDGETDC               equ 68
DDSETCOOPERATIVELEVEL equ 80
DDSETDISPLAYMODE      equ 84
DDLOCK                equ 100
DDRELEASEDC           equ 104
DDRESTORE             equ 108
DDUNLOCK              equ 128

; DirectX object types
LPDIRECTDRAW typedef ptr dword
LPDIRECTDRAWSURFACE typedef ptr dword
LPDIRECTDRAWCLIPPER typedef ptr dword
LPDIRECTSOUND typedef ptr dword
LPDIRECTSOUNDBUFFER typedef ptr dword

MakeWindow proto WName: dword, WProc: dword
WndProc proto W: dword, M: dword, WP: dword, LP: dword
SetDirectDraw proto
Clear proto CColor: dword
Flip proto
Release proto Object: dword
LoadBMP proto FN: dword
DrawImage proto SImage: dword, X: dword, Y: dword, W: dword, H: dword, TC: dword
SetTransparent proto SImage: dword
SetDirectSound proto
LoadWAV proto FN: dword
Play proto SoundP: dword, LoopS: dword
Collide proto R: dword, R2: dword
MoveImage proto ImageP: dword, Direction: dword, NPixels: dword
Debug proto Number: dword

Image struc
X dd 0
Y dd 0
W dd ?
H dd ?
TC dd 0 ; (Unused but transparency works)
I LPDIRECTDRAWSURFACE 0
Image ends

UP equ 0
RIGHT equ 1
DOWN equ 2
LEFT equ 3

Zero macro M, N
mov edi, M
mov ecx, N
xor eax, eax
cld
rep stosd
endm

; ***************************** .data ********************************

.data
WindowName db 'MASM DirectX Example. Move with cursor keys. Esc to exit', 0
ErrorMsg   db 'Error', 0
BMPName    db 'asm.bmp', 0
WAVName    db 's.wav', 0
Instance   dd 0
Window     dd 0
Msg        MSG <?>
DC         HDC ?
Color      dd 0

DirectDraw    LPDIRECTDRAW 0
MainSurface   LPDIRECTDRAWSURFACE 0
BackBuffer    LPDIRECTDRAWSURFACE 0
BackBuffer2   LPDIRECTDRAWSURFACE 0
Clipper       LPDIRECTDRAWCLIPPER 0
DDSCAPS       dd ?
DDBLTFX       db 100 dup(?)
DirectSound   LPDIRECTSOUND 0

UpKey         dd 0
RightKey      dd 0
DownKey       dd 0
LeftKey       dd 0
TempR         RECT <?>
Start         dd ?
Time          dd 10 ; Edit this
DText         db 30 dup(?) ; For Debug
DFormat       db '%d', 0
DNumber       dd 0

MyImage       Image <?>
MySound       LPDIRECTSOUNDBUFFER 0

; ***************************** .code ********************************

.code
start:
callp MakeWindow, addr WindowName, addr WndProc
test eax, eax
jz Exit
mov Window, eax ; Save HWND and instance
mov Instance, edx
call SetDirectDraw
test eax, eax
jz Exit
call SetDirectSound
test eax, eax
jz Exit

callp LoadBMP, addr BMPName
mov MyImage.I, eax
mov MyImage.W, edx
mov MyImage.H, ecx
mov MyImage.Y, 110
;callp SetTransparent, MyImage.I

callp LoadWAV, addr WAVName
mov MySound, eax
callp Play, MySound, 1

; *************************** MessageLoop ******************************

MessageLoop:
callp PeekMessage, addr Msg, 0, 0, 0, PM_REMOVE
test eax, eax
jz GameLoop ; No messages pending. Update game
cmp Msg.message, WM_QUIT
jz Exit
callp TranslateMessage, addr Msg ; Convert VK_ keys
callp DispatchMessage, addr Msg ; Send to WndProc
jmp MessageLoop

; *************************** Game Loop ********************************

GameLoop:

; 1. Save start time
call GetTickCount
mov Start, eax

; 2. Clear back buffers
callp Clear, Color

; 3. Update everything...
callp DrawImage, MyImage.I, MyImage.X, MyImage.Y, MyImage.W, MyImage.H, 0
; Last parameter = 1 if transparent

; Draw text. GDI drawing causes flicker
callp GetDC, Window
mov DC, eax
callp TextOut, DC, 0, 0, addr WindowName, 56
callp ReleaseDC, Window, DC
callp Debug, DNumber

callp GetAsyncKeyState, VK_UP
mov UpKey, eax
callp GetAsyncKeyState, VK_RIGHT
mov RightKey, eax
callp GetAsyncKeyState, VK_DOWN
mov DownKey, eax
callp GetAsyncKeyState, VK_LEFT
mov LeftKey, eax
callp GetAsyncKeyState, VK_SPACE
cmp eax, 0
jz NoSpace
callp Play, MySound, 1
NoSpace:

cmp UpKey, 0
jz IsRight
callp MoveImage, addr MyImage, UP, 10
IsRight:
cmp RightKey, 0
jz IsDown
callp MoveImage, addr MyImage, RIGHT, 10
IsDown:
cmp DownKey, 0
jz IsLeft
callp MoveImage, addr MyImage, DOWN, 10
IsLeft:
cmp LeftKey, 0
jz NoKey
callp MoveImage, addr MyImage, LEFT, 10
NoKey:

; 4. Show back buffer. Do nothing while time not expired
call Flip
DoNothing:
call GetTickCount
sub eax, Start
cmp eax, Time
jbe DoNothing

; 5. Return to message loop
jmp MessageLoop

Exit:
callp ExitProcess, Msg.wParam

; *************************** WndProc **********************************

WndProc proc W: dword, M: dword, WP: dword, LP: dword
mov eax, M
cmp eax, WM_KEYDOWN ; Most likely case
jz OnKeyDown
cmp eax, WM_KEYUP
jz OnKeyUp
cmp eax, WM_MOUSEMOVE
jz OnMouseMove
cmp eax, WM_LBUTTONDOWN
jz OnLButtonDown
cmp eax, WM_LBUTTONUP
jz OnLButtonUp
cmp eax, WM_PAINT
jz OnPaint
cmp eax, WM_CHAR
jz OnChar
cmp eax, WM_CREATE
jz OnCreate
cmp eax, WM_DESTROY
jz OnDestroy
jmp WPDefault ; Default Windows processing

OnCreate:
jmp WPExit
OnPaint:
jmp WPDefault

OnKeyDown:
cmp WP, VK_ESCAPE
jnz NotEsc
callp SendMessage, Window, WM_DESTROY, 0, 0
NotEsc:
jmp WPExit

OnKeyUp:
jmp WPExit
OnChar:
jmp WPExit
OnMouseMove:
jmp WPExit
OnLButtonDown:
jmp WPExit
OnLButtonUp:
jmp WPExit

OnDestroy:
; Images/sounds may be released anytime
callp Release, MyImage.I
callp Release, MySound
callp Release, Clipper ; DirectX objects must be released in this order...
callp Release, BackBuffer
callp Release, BackBuffer2
callp Release, MainSurface
callp Release, DirectDraw ; Don't release this first
callp Release, DirectSound
callp PostQuitMessage, 0
jmp WPExit

WPDefault:
callp DefWindowProc, W, M, WP, LP
WPExit:
ret
WndProc endp

; ************************** MakeWindow ***************************

; Create and show Window. Parameters: Window name and procedure.
; Return: eax = HWND or 0 if error. edx = Instance

MakeWindow proc WName: dword, WProc: dword
local WC: WNDCLASSEX
local ClassName: dword
local WindowR: dword
local InstanceR: dword
mov eax, 11111111h ; Mark beginning
mov ClassName, 00005A45h ; 'EZ', 0, 0

; Save module handle
callp GetModuleHandle, 0
mov InstanceR, eax

; Define and register Window class
mov WC.cbSize, 30h
mov WC.style, 0
push WProc
pop WC.lpfnWndProc
mov WC.cbClsExtra, 0
mov WC.cbWndExtra, 0
push InstanceR
pop WC.hInstance
mov WC.hbrBackground, 73Eh
mov WC.lpszMenuName, 0
lea eax, ClassName
mov WC.lpszClassName, eax
callp LoadIcon, 0, IDI_APPLICATION
mov WC.hIcon, eax
mov WC.hIconSm, eax
callp LoadCursor, 0, IDC_ARROW
mov WC.hCursor, eax
callp RegisterClassEx, addr WC
test eax, eax
jz MWError

; Create Window
callp CreateWindowEx, WS_EX_TOPMOST, addr ClassName, WName, WS_VISIBLE or\
WS_POPUP, 0, 0, 640, 480, 0, 0, InstanceR, 0
test eax, eax
jz MWError
mov WindowR, eax

; Window setup
callp ShowWindow, WindowR, SW_SHOWNORMAL
callp UpdateWindow, WindowR

mov eax, 99999999h ; Mark end
mov eax, WindowR
mov edx, InstanceR
ret
MWError:
xor eax, eax
ret
MakeWindow endp

; *************************** SetDirectDraw *************************

SetDirectDraw proc
local DDSURFACEDESC[108]: byte

; Create DirectDraw
callp DirectDrawCreate, 0, addr DirectDraw, 0

; SetCooperativeLevel
push 11h ; Flags: FRONTBUFFER | CAPS
push Window
calldx DirectDraw, DDSETCOOPERATIVELEVEL

; SetDisplayMode
push 16
push 480
push 640
calldx DirectDraw, DDSETDISPLAYMODE
test eax, eax ; All DirectX methods return 0/DX_OK if success
jnz DDError

; Create MainSurface
lea eax, DDSURFACEDESC
mov dword ptr [eax], 108        ; dwSize
mov dword ptr [eax + 4], 21h    ; dwFlags
mov dword ptr [eax + 104], 218h ; dwCaps: PRIMARY, FLIP, COMPLEX
mov dword ptr [eax + 20], 2     ; dwBackBufferCount
push 0
push offset MainSurface
lea eax, DDSURFACEDESC
push eax
calldx DirectDraw, DDCREATESURFACE
test eax, eax
jnz DDError

; Attach back buffer
push offset BackBuffer
mov DDSCAPS, 4 ; BACKBUFFER flag
push offset DDSCAPS
calldx MainSurface, DDGETATTACHEDSURFACE
test eax, eax
jnz DDError

; Attach back buffer 2
push offset BackBuffer2
mov DDSCAPS, 4
push offset DDSCAPS
calldx MainSurface, DDGETATTACHEDSURFACE
test eax, eax
jnz DDError

; Create clipper. So, images can move outside screen boundaries
push 0
push offset Clipper
push 0
calldx DirectDraw, 16
test eax, eax
jnz DDError
; Clipper > Set HWND
push Window
push 0
calldx Clipper, 32
test eax, eax
jnz DDError
; Surface > SetClipper
push Clipper
calldx BackBuffer, 112
test eax, eax
jnz DDError

mov eax, 1
ret
DDError:
xor eax, eax
ret
SetDirectDraw endp

; ********************* Animation: Clear, Flip *************************

; Clear. Fill screen with color

Clear proc CColor: dword
local BLTFX[100]: byte
lea eax, BLTFX
mov dword ptr [eax], 100 ; dwSize
mov edx, CColor
mov dword ptr [eax + 80], edx ; dwFillColor
push eax ; EDIT
push 1000400h ; Flags: COLORFILL | WAIT
push 0
push 0
push 0
calldx BackBuffer, DDBLT
ret
Clear endp

; Show back buffer

Flip proc
push 1 ; DDFLIP_WAIT
push 0
calldx MainSurface, DDFLIP
ret
Flip endp

; ****************************** Release ******************************

; Free DirectX object

Release proc Object: dword
cmp dword ptr [Object], 0 ; If released, end
jz ReleaseEnd
calldx Object, DDRELEASE
mov dword ptr [Object], 0
ReleaseEnd:
ret
Release endp

; ****************************** LoadBMP *******************************

; Load .bmp. Return: eax = Image, LPDIRECTDRAWSURFACE or 0 if error.
; edx/ecx = Image width/height

LoadBMP proc FN: dword
local HBM: HBITMAP
local BM: BITMAP
local BMDC: HDC
local SDC: HDC
local ImageP: LPDIRECTDRAWSURFACE
local DDSURFACEDESC[108]: byte
;mov I, 0

; 1. Load .bmp
callp LoadImage, 0, FN, 0, 0, 0, 2010h
test eax, eax
jz BMPError
mov HBM, eax
callp GetObject, HBM, 24, addr BM

; 2. Create surface image
; Setup DDSURFACEDES...
lea edi, DDSURFACEDESC
xor eax, eax
mov ecx, 27
cld
rep stosd
lea eax, DDSURFACEDESC
mov dword ptr [eax], 108        ; dwSize
mov dword ptr [eax + 4], 7      ; dwFlags: CAPS, HEIGHT, WIDTH
mov dword ptr [eax + 104], 840h ; dwCaps: OFFSCREENPLAIN, SYSTEMMEMORY
mov edx, BM.bmWidth
mov dword ptr [eax + 12], edx
mov edx, BM.bmHeight
mov dword ptr [eax + 8], edx
; Note: Images are created in system memory so the mysterious "lost surface"
; error never occurs
push 0 ; DirectDraw > CreateSurface(DDSURFACEDES *, LPDIRECTDRAWSURFACE *, 0)
lea eax, ImageP
push eax
lea eax, DDSURFACEDESC
push eax
calldx DirectDraw, DDCREATESURFACE
test eax, eax ; CreateSurface returns zero if true
jnz BMPError

callp CreateCompatibleDC, 0
mov BMDC, eax
callp SelectObject, BMDC, HBM

; 3. Get image DC
lea eax, SDC ; Image > GetDC(DC *)
push eax
calldx ImageP, DDGETDC

; 4. Draw .bmp to surface image. Only do this once
callp BitBlt, SDC, 0, 0, BM.bmWidth, BM.bmHeight, BMDC, 0, 0, SRCCOPY

; 5. Delete everything...
push SDC ; Image > ReleaseDC
calldx ImageP, DDRELEASEDC
callp DeleteDC, BMDC
callp DeleteObject, HBM
mov eax, ImageP
mov edx, BM.bmWidth ; Return size in edx, ecx
mov ecx, BM.bmHeight
ret
BMPError:
xor eax, eax
ret
LoadBMP endp

; *************************** SetTransparent ***************************

; Make image transparent by pixel at 0, 0

SetTransparent proc SImage: dword
local DDCOLORKEY[8]: byte
local DDSURFACEDESC[108]: byte
local Value: dword

; Lock surface and get DESC...
lea eax, DDSURFACEDESC
mov dword ptr [eax], 108 ; dwSize
ReLock:
push 0 ; Surface > Lock
push 0
lea ebx, DDSURFACEDESC
push ebx
push 0
calldx SImage, DDLOCK
cmp eax, 08876021Ch ; DDERR_WASSTILLDRAWING
jz ReLock
test eax, eax
jnz CKError
; Get color in upper left corner
lea eax, DDSURFACEDESC
mov eax, [eax + 36] ; lpSurface
mov eax, [eax] ; Dereference
push eax
push 0
calldx SImage, DDUNLOCK
pop eax
lea ebx, DDCOLORKEY
mov dword ptr [ebx], eax
mov dword ptr [ebx + 4], eax
mov Value, eax
; Set color key...
push ebx
push 8 ; DDCKEY_SRCBLT
calldx SImage, 116
test eax, eax
jnz CKError
mov eax, 1
ret
CKError:
xor eax, eax
ret
SetTransparent endp

; ****************************** DrawImage *****************************

; Draw image to back buffer. SImage: LPDIRECTDRAWSURFACE. TC = 1/0, transparent.
; For transparent images, SetTransparent and TC = 1

DrawImage proc SImage: dword, X: dword, Y: dword, W: dword, H: dword, TC: dword
mov eax, X ; Setup RECT...
mov TempR.left, eax
add eax, W
mov TempR.right, eax
mov eax, Y
mov TempR.top, eax
add eax, H
mov TempR.bottom, eax
push 0
mov edx, 0 ; Default to no transparent
cmp TC, 1
jnz DINo
mov edx, 8000h ; SRCCOLORKEY
DINo:
push edx
push 0
push SImage
push offset TempR
calldx BackBuffer, DDBLT
cmp eax, 887601C2h ; DDERR_SURFACELOST
jz Restore
ret
Restore:
calldx SImage, DDRESTORE
calldx MainSurface, DDRESTORE
calldx BackBuffer, DDRESTORE
calldx BackBuffer2, DDRESTORE
ret
DrawImage endp

; **************************** SetDirectSound **************************

SetDirectSound proc
callp DirectSoundCreate, 0, addr DirectSound, 0
test eax, eax
jnz DSError
push 1 ; DSSCL_NORMAL
push Window
calldx DirectSound, 24
test eax, eax
jnz DSError
mov eax, 1
ret
DSError:
xor eax, eax
ret
SetDirectSound endp

; ******************************* LoadWAV ******************************

; Load .wav. Return LPDIRECTSOUNDBUFFER or 0 if error

LoadWAV proc FN: dword
local WAV: dword
local WAVData[20]: byte ; MMCKINFO
local FMTData[20]: byte ; Same
local WAVInfo[18]: byte ; WAVEFORMATEX
local DSBUFFERDESC[20]: byte
local SoundBuffer: dword ; LPDIRECTSOUNDBUFFER
local Audio1: dword
local Audio2: dword
local Length1: dword
local Length2: dword

callp mmioOpen, FN, 0, 10000h ; MMIO_READ | MMIO_ALLOCBUF
test eax, eax
jz LWError
mov WAV, eax
lea ebx, WAVData
Zero ebx, 5
mov dword ptr [ebx + 8], 45564157h ; fccType = 'WAVE'
callp mmioDescend, WAV, ebx, 0, MMIO_FINDRIFF
lea ebx, FMTData
Zero ebx, 5
mov dword ptr [ebx + 8], 20746D66h ; fccType = 'fmt '
callp mmioDescend, WAV, ebx, addr WAVData, 0
callp mmioRead, WAV, addr WAVInfo, 18
lea ebx, WAVInfo
cmp word ptr [ebx], WAVE_FORMAT_PCM ; Verify signature
jnz LWError
callp mmioAscend, WAV, addr FMTData, 0
lea ebx, FMTData
mov dword ptr [ebx], 61746164h ; ckid = 'data '
callp mmioDescend, WAV, addr FMTData, addr WAVData, MMIO_FINDCHUNK
lea ebx, DSBUFFERDESC
mov dword ptr [ebx], 20 ; dwSize
mov dword ptr [ebx + 4], 224 ; Flags. DSBCAPS_CTRLDEFAULT
lea eax, [FMTData + 4]
mov dword ptr [ebx + 8], eax ; dwBufferBytes = FMTData.cksize
mov dword ptr [ebx + 12], 0
lea eax, WAVInfo
mov dword ptr [ebx + 16], eax ; lpwfxWAVFormat = offset WAVInfo
push 0 ; DSound > CreateSoundBuffer
lea eax, SoundBuffer
push eax
push ebx
calldx DirectSound, 12
test eax, eax
jnz LWError
mov Audio1, 0 ; Circular buffers
mov Audio2, 0
push 0 ; IDirectSoundBuffer > Lock
lea ebx, Length2
push ebx
lea edx, Audio2
push edx
lea ebx, Length1
push ebx
lea edx, Audio1
push edx
push dword ptr [FMTData + 4]
push 0
calldx SoundBuffer, 44
; Write sounds...
cmp Audio1, 0
jbe LWNo ; unsigned
callp mmioRead, WAV, Audio1, Length1
LWNo:
cmp Audio2, 0
jbe LWNo2
callp mmioRead, WAV, Audio2, Length2
LWNo2:
push Length2 ; IDirectSoundBuffer > Unlock
push Audio2
push Length1
push Audio1
calldx SoundBuffer, 76
callp mmioClose, WAV, 0
mov eax, SoundBuffer
ret
LWError:
xor eax, eax
ret
LoadWAV endp

; ******************************** Play *******************************

; Play sound. It had to be named "Play". "PlaySound" is a reserved name.
; LoopS = 1/0

Play proc SoundP: dword, LoopS: dword
push 0
calldx SoundP, 52 ; SetCurrentPosition
push LoopS
push 0
push 0
calldx SoundP, 48 ; IDirectSoundBuffer > Play
ret
Play endp

; ******************************* Collide ******************************

; Detect collision. eax = 1/0. Send 2 RECT pointers

Collide proc R: dword, R2: dword
; left, top, right, bottom
lea eax, [R] ; 
cmp eax, [R2 + 8]
jg CNo
lea edx, [R + 4]
cmp edx, [R2 + 12]
jg CNo
lea eax, [R + 8]
cmp eax, [R2]
jl CNo
lea edx, [R + 12]
cmp edx, [R2 + 4]
jl CNo
mov eax, 1
ret
CNo:
xor eax, eax
ret
Collide endp

; ***************************** MoveImage *****************************

; Move direction, # pixels. Direction = 0/UP, 1/RIGHT, 2/DOWN, 3/LEFT

MoveImage proc ImageP: dword, Direction: dword, NPixels: dword
mov eax, ImageP
assume eax: ptr Image
mov ecx, NPixels
mov edx, Direction
cmp edx, UP
jz MIUp
cmp edx, RIGHT
jz MIRight
cmp edx, DOWN
jz MIDown
cmp edx, LEFT
jz MILeft
ret
MIUp:
sub dword ptr [eax].Y, ecx
jmp MIEnd
MIRight:
add dword ptr [eax].X, ecx
jmp MIEnd
MIDown:
add dword ptr [eax].Y, ecx
jmp MIEnd
MILeft:
sub dword ptr [eax].X, ecx
MIEnd:
ret
MoveImage endp

MoveBox proc RectP: dword, Direction: dword, NPixels: dword
mov eax, RectP
mov ecx, NPixels
mov edx, Direction
cmp edx, UP
jz MRUp
cmp edx, RIGHT
jz MRRight
cmp edx, DOWN
jz MRDown
cmp edx, LEFT
jz MRLeft
ret
MRUp:
sub dword ptr [eax + 4], ecx
ret
MRRight:
add dword ptr [eax], ecx
ret
MRDown:
add dword ptr [eax + 8], ecx
ret
MRLeft:
sub dword ptr [eax + 12], ecx
ret
MoveBox endp

; ******************************* Debug *******************************

; View value of number

Debug proc Number: dword
push Number
push offset DFormat
push offset DText
call wsprintfA
callp GetDC, Window
callp TextOut, eax, 0, 100, addr DText, 30
callp ReleaseDC, Window, DC
ret
Debug endp

; ***************************** GAME OVER *****************************
end start
    
Post 12 Nov 2012, 17:14
View user's profile Send private message Reply with quote
uart777



Joined: 17 Jan 2012
Posts: 369
JohnFound: Please understand that I'm on an Android phone, not a standard laptop/desktop, and there are other reasons for mistakes in my posts that I definitely don't want to talk about (ie, multiple legal prescriptions).

I apologize for not presenting code the way you think I should, but this post is about HL MACROS, NOT font tags, site designs and unrelated things. I will be serious and stay on subject if everyone else does. Thanks.

PS: LANGUAGE.INC is commented with examples and the files were only included to demonstrate how to use them.


Last edited by uart777 on 17 Nov 2012, 06:07; edited 1 time in total
Post 14 Nov 2012, 15:14
View user's profile Send private message Reply with quote
uart777



Joined: 17 Jan 2012
Posts: 369
One more thing: Some people come here and post one little macro that doesn't work. I just now posted about 100+ macros/functions so there may be errors or unfinished or untested code.
Post 15 Nov 2012, 01:19
View user's profile Send private message Reply with quote
pool



Joined: 08 Jan 2007
Posts: 93
..


Last edited by pool on 17 Mar 2013, 12:21; edited 1 time in total
Post 03 Jan 2013, 16:41
View user's profile Send private message Reply with quote
uart777



Joined: 17 Jan 2012
Posts: 369
pool: Hi. typedef is not needed. fix can create alternative names for HL variable types, functions, macros, etc. Since fix renames everything that follows it, be careful and only use it sparingly. Example:

Code:
integer fix NUMBER
string  fix TEXT
void    fix VOID

strlen  fix text.n
strcpy  fix text.copy 
strcmp  fix text.compare
strcat  fix text.attach
strchr  fix text.find
strstr  fix text.search

malloc  fix allocate
realloc fix allocate.p
free    fix destroy

memset  fix memory.set
memcpy  fix memory.copy    


HL structures are like typedef struct in C. Example:

Code:
STRUCTURE IMAGE
 VOID p
 NUMBER x, y, w, h, bpp
 COLOR key, alpha
ENDS

TYPE NAME = TEXT first(32), middle(32), last(32)

TYPE ADDRESS = TEXT country(32), street(64),\
 city(64), state(32), zip(16)

STRUCTURE PROFILE
 IMAGE image
 TEXT about(256), interests(256), quote(256)
ENDS

STRUCTURE USER
 TEXT username(32), password(32)
 NAME name
 ADDRESS address
 NUMBER age, gender, race, status,\
  height, weight
 COLOR eye.color, hair.color
 PROFILE profile
ENDS    
Post 04 Jan 2013, 04:25
View user's profile Send private message Reply with quote
pool



Joined: 08 Jan 2007
Posts: 93
..


Last edited by pool on 17 Mar 2013, 12:21; edited 1 time in total
Post 04 Jan 2013, 04:51
View user's profile Send private message Reply with quote
TmX



Joined: 02 Mar 2006
Posts: 819
Location: Jakarta, Indonesia
How can I use the macros?
It would be nice if you provide some small working examples Smile
Post 04 Jan 2013, 07:51
View user's profile Send private message Reply with quote
uart777



Joined: 17 Jan 2012
Posts: 369
pool: Yes, it's like a miniature HL compiler within FASM Cool

TmX wrote:
Quote:
How can I use the macros?


VARIABLES: BYTE, NUMBER, TEXT, VOID

Code:
BYTE a, b='$', c=' '
NUMBER n
VOID p   ; 32 or 64BIT

TEXT title='My Application', buffer(256)

TEXTS fruits[]= 'Apple', 'Banana', 'Blueberry', 'Cherry',\
 'Grape', 'Lemon', 'Lime', 'Orange', 'Peach', 'Watermelon'

TEXTS registers.32[8](4)=\    ; with alignment, size=4 bytes each
 'eax', 'ecx', 'edx', 'ebx',\
 'esp', 'ebp', 'esi', 'edi'    


OPERATIONS: LET, GET, TRY

let performs HL assignments and operations. Think of it as the inverse of _asm {} block in C. Example:

Code:
let \ ; extract r/g/b components
 ecx=eax, ecx>>16, ecx&0FFh, [sr]=ecx,\
 ecx=eax, ecx>>8, ecx&0FFh, [sg]=ecx,\
 ecx=eax, ecx&0FFh, [sb]=ecx,\
 ecx=edx, ecx>>16, ecx&0FFh, [dr]=ecx,\
 ecx=edx, ecx>>8, ecx&0FFh, [dg]=ecx,\
 ecx=edx, ecx&0FFh, [db]=ecx

let \ ; calculate deltas: (((s-d)*a)/256)+d
 eax=[sr], eax-[dr], eax*[n], eax>>8, eax+[dr],\
 ecx=[sg], ecx-[dg], ecx*[n], ecx>>8, ecx+[dg],\
 edx=[sb], edx-[db], edx*[n], edx>>8, edx+[db]

let \ ; construct RGB
 eax<<16, ecx<<8, eax|ecx, eax|edx    


Note: let is derived from the original version of BASIC (Dartmouth) in 1964. LANGUAGE.INC contains classic syntaxes that were dug up from the past and revised.

get calls a function then assigns its return value. Example:

Code:
get [n]=strlen t
get [dice]=random 6
get [color]=rgb [x], [y], [z]

; output...

push t
call !text.n
mov [n], eax
push 6
call !random
mov [dice], eax
push [z]
push [y]
push [x]
call !rgb
mov [color], eax    


try calls a function then returns 0 (jmp to return label) if it does. Optionally, it can assign a variable like get:

Code:
try open [file]
try [p]=allocate 64*KB
try read [p], [n]

; output...

push [file]
call !open
test eax, eax
jz .!
push 65536
call !allocate
mov [p], eax
test eax, eax
jz .!
push [n]
push [p]
call !read
test eax, eax
jz .!    


STRUCTURES

STRUCTURE is an extension of FASM's \MACRO\STRUCT.INC that's easier to use. Optional ?name after ENDS creates a virtual structure to add to a base address or register: let [?image.x+eax]=0. Example:

Code:
STRUCTURE HUMAN
 TEXT name(32)
 NUMBER age, gender, height, weight
 TEXT address(256), phone(16), email(64)
ENDS ?human    


Multiple instances can be created on the same line as in HL languages:

Code:
HUMAN me, you, him, her    


TYPE is a shortcut to create small structures. All members are of the same type:

Code:
TYPE POINT = NUMBER x, y
TYPE LINE  = POINT a, b
TYPE SIZE  = NUMBER w, h
TYPE BOX   = NUMBER x, y, w, h
TYPE RECT  = NUMBER left, top, right, bottom
TYPE RGB   = NUMBER a, r, g, b    


WINDOWS

Some common Windoze definitions and structures (copy and paste):

Code:
STRUCTURE MSG
 NUMBER hwnd, message, wParam, lParam,\
 time, pt.x, pt.y
ENDS

STRUCTURE WNDCLASSEX
 NUMBER cbSize=48, style, lpfnWndProc,\
 cbClsExtra, cbWndExtra, hInstance, hIcon,\
 hCursor, hbrBackground, lpszMenuName,\
 lpszClassName, hIconSm
ENDS ?wc

numeric \ ; window messages
WM_CREATE=1, WM_DESTROY=2, WM_MOVE=3,\
WM_SIZE=5, WM_SETFOCUS=7, WM_KILLFOCUS=8,\
WM_GETTEXT=0Dh, WM_SETTEXT=0Ch,\
WM_GETTEXTLENGTH=0Eh, WM_PAINT=0Fh,\
WM_CLOSE=10h, WM_QUIT=12h, WM_CUT=300h,\
WM_COPY=301h, WM_PASTE=302h, WM_CLEAR=303h,\
WM_SETFONT=30h, WM_COMMAND=111h, WM_TIMER=0113h

numeric \ ; window styles
WS_POPUP=80000000h,\
WS_MINIMIZE=20000000h, WS_VISIBLE=10000000h,\
WS_MAXIMIZE=1000000h, WS_CAPTION=0C00000h,\
WS_BORDER=800000h, WS_DLGFRAME=400000h,\
WS_VSCROLL=200000h, WS_HSCROLL=100000h,\
WS_SYSMENU=80000h, WS_THICKFRAME=40000h,\
WS_MINIMIZEBOX=20000h, WS_MAXIMIZEBOX=10000h,\
WS_BLANK=WS_VISIBLE+WS_POPUP,\
WS_DEFAULT=WS_VISIBLE\
+WS_CAPTION+WS_MINIMIZEBOX+WS_SYSMENU

numeric \ ; keyboard messages
WM_KEYDOWN=100h, WM_KEYUP, WM_CHAR, WM_DEADCHAR,\
WM_SYSKEYDOWN, WM_SYSKEYUP, WM_SYSCHAR

numeric \ ; mouse messages
WM_MOUSEMOVE=200h, WM_LBUTTONDOWN, WM_LBUTTONUP,\
WM_LBUTTONDBLCLK, WM_RBUTTONDOWN, WM_RBUTTONUP,\
WM_RBUTTONDBLCLK, WM_MBUTTONDOWN, WM_MBUTTONUP,\
WM_MBUTTONDBLCLK, WM_MOUSEWHEEL

; virtual key codes. function keys=(6Fh+N).
; example: F1=70h (6Fh+1)

numeric \
VK_LEFT=25h, VK_UP=26h,\
VK_RIGHT=27h, VK_DOWN=28h,\
VK_ESCAPE=1Bh, VK_SPACE=20h,\
VK_DELETE=2Eh, VK_LCONTROL=0A2h,\
VK_RCONTROL=0A3h, VK_LALT=0A4h,\
VK_RALT=0A5h, VK_BACK=8, VK_TAB=9,\
VK_RETURN=0Dh, VK_END=23h, VK_HOME=24h

HDC fix VOID
HFONT fix VOID
HBITMAP fix VOID

SRCCOPY=00CC0020h

STRUCTURE PAINTSTRUCT
 NUMBER hdc, fErase
 RECT rcPaint
 NUMBER fRestore, fIncUpdate
 BLOCK rgbReserved(32)
ENDS ?paint.struct

STRUCTURE BITMAP
 NUMBER bmType, bmWidth, bmHeight,\
 bmWidthBytes
 WORD bmPlanes, bmBitsPixel
 VOID bmBits
ENDS ?bitmap

STRUCTURE BITMAPINFOHEADER
 NUMBER biSize, biWidth, biHeight
 WORD biPlanes, biBitCount
 NUMBER biCompression, biSizeImage,\
 biXPelsPerMeter, biYPelsPerMeter,\
 biClrUsed, biClrImportant
ENDS

STRUCTURE BITMAPINFO
 BITMAPINFOHEADER h
 DWORD bmiColors
ENDS ?bitmap.info

STRUCTURE BITMAPFILEHEADER
 WORD bfType
 NUMBER bfSize, bfReserved, bfOffBits
ENDS

STRUCTURE LOGFONT
 NUMBER nHeight, nWidth, nEscapement,\
 nOrientation, fnWeight, fdwItalic,\
 fdwUnderline, fdwStrikeOut, fdwCharSet,\
 fdwOutputPrecision, fdwClipPrecision,\
 fdwQuality, fdwPitchAndFamily
 TEXT lpszFace(32)
ENDS ?log.font

numeric FW_LIGHT=300, FW_NORMAL=400,\
FW_MEDIUM=500, FW_BOLD=700, FW_HEAVY=900

numeric DEFAULT_QUALITY, DRAFT_QUALITY,\
PROOF_QUALITY, NONANTIALIASED_QUALITY,\
ANTIALIASED_QUALITY

STRUCTURE CHOOSECOLOR
 NUMBER lStructSize, hwndOwner, hInstance,\
 rgbResult, lpCustColors, Flags, lCustData,\
 lpfnHook, lpTemplateName
ENDS ?choose.color

numeric CC_RGBINIT=1, CC_FULLOPEN=2

STRUCTURE CHOOSEFONT
 NUMBER lStructSize, hwndOwner, hDC, lpLogFont,\
 iPointSize, Flags, rgbColors, lCustData,\
 lpfnHook, lpTemplateName, hInstance, lpszStyle
 WORD nFontType, wReserved
 NUMBER nSizeMin, nSizeMax
ENDS ?choosefont

numeric CF_SCREENFONTS=1, CF_PRINTERFONTS=2,\
CF_BOTH=3, CF_INITTOLOGFONTSTRUCT=40h,\
CF_EFFECTS=100h

STRUCTURE OPENFILENAME
 NUMBER lStructSize, hwndOwner, hInstance,\
  lpstrFilter, lpstrCustomFilter,\
  nMaxCustFilter, nFilterIndex, lpstrFile,\
  nMaxFile, lpstrFileTitle, nMaxFileTitle,\
  lpstrInitialDir, lpstrTitle, Flags
 WORD nFileOffset, nFileExtension
 NUMBER lpstrDefExt, lCustData,\
  lpfnHook, lpTemplateName
ENDS ?openfilename

numeric OFN_READONLY=1, OFN_OVERWRITEPROMPT=2,\
OFN_HIDEREADONLY=4, OFN_ALLOWMULTISELECT=200h,\
OFN_PATHMUSTEXIST=800h, OFN_FILEMUSTEXIST=1000h,\
OFN_CREATEPROMPT=2000h    


FILE I/O

Code:
; example...

include 'z.inc'

TEXT t(128),\
 f='EXAMPLE.TXT',\
 s='EXAMPLE TEXT DATA'
n=s.$

code
create f   ; create file
write s, n ; write to current file
close      ; close after create
open f     ; reopen
read t, n  ; read to t
say t      ; display text
close      ; close after open
execute f  ; ShellExecute maximize
exit       ; ExitProcess 0    


"WHY USE LET?"

* let translates directly to pure X86 instructions so there is absolutely NO overhead. What you see is what you get. Please view the disassembly and see for yourself
* =/=&/+/-/<</etc are just shortcut symbols to mov/lea/add/sub/shl/etc
* Unlike HL infix expressions, you specify BOTH destination AND source operands and there is NO compiler making random decisions behind the scenes about which spare registers to use for sub/expressions
* let does NOT alter ANY registers except specified destination/"lvalue": let eax=ecx
* let supports the SAME operands as the instructions so you MUST know ASM well in order to use it properly. Example: x<<y must be written as: let eax=[x], ecx=>[y], eax<<cl (PS: Only one exception: let [x]=[y] is push then pop. = is the only one that allows m,m)
* let can be written with all registers and it produces exactly what you'd write in pure ASM: .convert: let eax=[esi], eax&0FFh, eax<<24, [edi]|eax, edi+4, esi+4, ecx-- jnz .convert ; would be 5 times longer if it were written on separate lines. That's a difference between 2,000 and 10,000 lines!
* let improves readability, makes code compact and easier to manage
* let can be edited to output FPU and other CPU cores - ARM, Java, etc - whatever you want it to. In FASM, you have 100% control of output code
* Easy translation to/from equations/expressions with symbols. Example: align n+(((p-1)-(n+p-1))&(p-1)) = let ecx=[p], ecx-1, edx=[n], edx+ecx, eax=ecx, eax-edx, eax&ecx, ecx=eax, edx=[n], eax+edx
* Easy conversion to/from HL languages

Any questions? Ask.

"My style is the best way for me personally and the best way that I know of currently but I'm always open-minded to the possibility that there is a better way"
Post 04 Jan 2013, 14:28
View user's profile Send private message Reply with quote
Display posts from previous:
Post new topic Reply to topic

Jump to:  


< Last Thread | Next Thread >
Forum Rules:
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
You cannot attach files in this forum
You can download files in this forum


Copyright © 1999-2019, Tomasz Grysztar.

Powered by rwasa.