Project Manhattan

User projects written in or related to FreeBASIC.
fatman2021
Posts: 215
Joined: Dec 14, 2013 0:43

Re: Project Manhattan

Post by fatman2021 »

Image

Cornell University has a great article about rendering realistic images that is worth checking out:
http://www.graphics.cornell.edu/online/box/data.html
fatman2021
Posts: 215
Joined: Dec 14, 2013 0:43

Re: Project Manhattan

Post by fatman2021 »

Round Cone:

Code: Select all

/'
Original Code:
// Round cone - exact
float sdRoundCone( vec3 p, float r1, float r2, float h )
{
  // sampling independent computations (only depend on shape)
  float b = (r1-r2)/h;
  float a = sqrt(1.0-b*b);

  // sampling dependant computations
  vec2 q = vec2( length(p.xz), p.y );
  float k = dot(q,vec2(-b,a));
  if( k<0.0 ) return length(q) - r1;
  if( k>a*h ) return length(q-vec2(0.0,h)) - r2;
  return dot(q, vec2(a,b) ) - r1;
}

Intermediate Code:
double _ZN12SYSTEM_BUS_T11SDROUNDCONEER7VECTOR3ddd( struct $12SYSTEM_BUS_T* THIS$1, struct $7VECTOR3* P$1, \
                                                    double R1$1, double R2$1, double H$1 )
{
 struct $7VECTOR2 TMP$1959$1;
 struct $7VECTOR2 TMP$1960$1;
 struct $7VECTOR2 TMP$1963$1;
 double fb$result$1;
 __builtin_memset( &fb$result$1, 0, 8ll );
 label$2277:;
 double B$1;
 B$1 = (R1$1 - R2$1) / H$1;
 double A$1;
 double vr$6 = _Z4SQRTd( -(B$1 * B$1) + 0x1.p+0 );
 A$1 = vr$6;
 struct $7VECTOR2 Q$1;
 struct $7VECTOR2* vr$9 = _ZN7VECTOR32XZEv( &TMP$1959$1, P$1 );
 double vr$10 = _Z6LENGTHRK7VECTOR2( (struct $7VECTOR2*)vr$9 );
 _ZN7VECTOR2C1Edd( &Q$1, vr$10, *(double*)((uint8*)P$1 + 8ll) );
 double K$1;
 _ZN7VECTOR2C1Edd( &TMP$1960$1, -B$1, A$1 );
 double vr$16 = _Z3DOTR7VECTOR2S0_( &Q$1, &TMP$1960$1 );
 K$1 = vr$16;
 if( K$1 >= 0x0p+0 ) goto label$2280;
 {
  double vr$18 = _Z6LENGTHRK7VECTOR2( (struct $7VECTOR2*)&Q$1 );
  fb$result$1 = vr$18 - R1$1;
  goto label$2278;
  label$2280:;
 }
 if( K$1 <= (A$1 * H$1) ) goto label$2282;
 {
  struct $7VECTOR2 TMP$1961$2;
  struct $7VECTOR2 TMP$1962$2;
  _ZN7VECTOR2C1Edd( &TMP$1961$2, 0x0p+0, H$1 );
  struct $7VECTOR2* vr$25 = _ZmiR7VECTOR2S0_( &TMP$1962$2, &Q$1, &TMP$1961$2 );
  double vr$26 = _Z6LENGTHRK7VECTOR2( (struct $7VECTOR2*)vr$25 );
  fb$result$1 = vr$26 - R2$1;
  goto label$2278;
  label$2282:;
 }
 _ZN7VECTOR2C1Edd( &TMP$1963$1, A$1, B$1 );
 double vr$31 = _Z3DOTR7VECTOR2S0_( &Q$1, &TMP$1963$1 );
 fb$result$1 = vr$31 - R1$1;
 goto label$2278;
 label$2278:;
 return fb$result$1;
}

FreeBASIC:
'/
proc SYSTEM_BUS_T.sdRoundCone( p as vector3, r1 as float, r2 as float, h as float) as float
  ' sampling independent computations (only depend on shape)
  dim as float b = (r1-r2)/h
  dim as float a = sqrt(1.0-b*b)

  ' sampling dependant computations
  dim as vector2 q = vector2( length(p.xz), p.y )
  dim as float k = dot(q,vector2(-b,a))
  if( k<0.0 ) then return length(q) - r1
  if( k>a*h ) then return length(q-vector2(0.0,h)) - r2
  return dot(q, vector2(a,b) ) - r1
end proc
coderJeff
Site Admin
Posts: 4313
Joined: Nov 04, 2005 14:23
Location: Ontario, Canada
Contact:

Re: Project Manhattan

Post by coderJeff »

Sorry to say my man, your project repo is quite the pile of junk. It's tough to tell who wrote which parts of the source. Many temporary and machine generated files. You may want to clean that up. Just a suggestion if you hope for any meaningful feedback.

Tip: search for usage of ".gitignore" to tell 'git' to ignore files that might exist in your working directory but don't want to commit to the public repository.

Not quite windows friendly. I'm guessing filenames with multiple name cases was a mistake:
cmd.exe wrote: D:\fbrepo>git clone https://github.com/fatman2021/project-manhattan
Cloning into 'project-manhattan'...
remote: Enumerating objects: 1824, done.
remote: Counting objects: 100% (258/258), done.
remote: Compressing objects: 100% (211/211), done.
remote: Total 1824 (delta 59), reused 230 (delta 43), pack-reused 1566Receiving objects: 99% (1806/1824), 463.14 MiB | 7.52 MiB/s
Receiving objects: 100% (1824/1824), 466.61 MiB | 7.34 MiB/s, done.
Resolving deltas: 100% (781/781), done.
Updating files: 100% (1049/1049), done.
warning: the following paths have collided (e.g. case-sensitive paths
on a case-insensitive filesystem) and only one from the same
colliding group is in the working tree:

'C64DOS.BAS'
'C64DOS.bas'
'c64dos.bas'
'GLSL.BI'
'glsl.bi'
'NIBBLES-DOS.TXT'
'nibbles-dos.txt'
fatman2021
Posts: 215
Joined: Dec 14, 2013 0:43

Re: Project Manhattan

Post by fatman2021 »

coderJeff wrote: Jul 16, 2022 20:50 Not quite windows friendly. I'm guessing filenames with multiple name cases was a mistake:
Filenames with multiple name cases is a UNIX/BSD/Linux thing. Sorry about that..
fatman2021
Posts: 215
Joined: Dec 14, 2013 0:43

Re: Project Manhattan

Post by fatman2021 »

CSNG

Code: Select all

' CSNG
proc SYSTEM_BUS_T.func_csng_float(value as float) as float
    if ((value <= 3.402823466E38) and (value >= -3.402823466E38)) then
        return value
    end if
    error(6)
    return 0
end proc

proc SYSTEM_BUS_T.func_csng_double(value as double) as double
    if ((value <= 3.402823466E38) and (value >= -3.402823466E38)) then
        return value
    end if
    error(6)
    return 0
end proc
fatman2021
Posts: 215
Joined: Dec 14, 2013 0:43

Re: Project Manhattan

Post by fatman2021 »

coderJeff wrote: Jul 16, 2022 20:50 Sorry to say my man, your project repo is quite the pile of junk. It's tough to tell who wrote which parts of the source. Many temporary and machine generated files. You may want to clean that up. Just a suggestion if you hope for any meaningful feedback.

Tip: search for usage of ".gitignore" to tell 'git' to ignore files that might exist in your working directory but don't want to commit to the public repository.

Not quite windows friendly. I'm guessing filenames with multiple name cases was a mistake:
cmd.exe wrote: D:\fbrepo>git clone https://github.com/fatman2021/project-manhattan
Cloning into 'project-manhattan'...
remote: Enumerating objects: 1824, done.
remote: Counting objects: 100% (258/258), done.
remote: Compressing objects: 100% (211/211), done.
remote: Total 1824 (delta 59), reused 230 (delta 43), pack-reused 1566Receiving objects: 99% (1806/1824), 463.14 MiB | 7.52 MiB/s
Receiving objects: 100% (1824/1824), 466.61 MiB | 7.34 MiB/s, done.
Resolving deltas: 100% (781/781), done.
Updating files: 100% (1049/1049), done.
warning: the following paths have collided (e.g. case-sensitive paths
on a case-insensitive filesystem) and only one from the same
colliding group is in the working tree:

'C64DOS.BAS'
'C64DOS.bas'
'c64dos.bas'
'GLSL.BI'
'glsl.bi'
'NIBBLES-DOS.TXT'
'nibbles-dos.txt'
Ok. I fixed it...Tray again...
https://github.com/fatman2021/project-manhattan
fatman2021
Posts: 215
Joined: Dec 14, 2013 0:43

Re: Project Manhattan

Post by fatman2021 »

LibC stuff:

Code: Select all

proc SYSTEM_BUS_T.k_min(v1 as SYSTEM_TYPE,v2 as SYSTEM_TYPE) as SYSTEM_TYPE
    if (v1<v2) then return v1
    return v2
end proc

proc SYSTEM_BUS_T.k_max(v1 as SYSTEM_TYPE,v2 as SYSTEM_TYPE) as SYSTEM_TYPE
    if (v1>v2) then return v1
    return v2
end proc

proc SYSTEM_BUS_T.k_strlen(s as ubyte ptr) as SYSTEM_TYPE
    dim retval as SYSTEM_TYPE
    retval=0
    while s[retval]<>0
        retval+=1
    wend
    return retval
end proc

proc SYSTEM_BUS_T.k_strtrim(s as ubyte ptr) as ubyte ptr
    dim retval  as ubyte ptr=@(Result(0))
    retval[0]=0
    dim i as integer=0
    dim j as integer=0
    while (s[i]<>0 and s[i]=32 and s[i]<>9 and s[i]<>10 and s[i]<>13)
        i+=1
    wend
    while(s[i]<>0)
        retval[j]=s[i]
        i+=1
        j+=1
    wend
    retval[j]=0
    
    k_strrev(retval)
    
    i=0
    j=0
    while (retval[i]<>0 and retval[i]=32 and retval[i]=9 and retval[i]=10 and retval[i]=13)
        i+=1
    wend
    while(retval[i]<>0)
        retval[j]=retval[i]
        i+=1
        j+=1
    wend
    retval[j]=0
   k_strrev(retval)
    
    return retval
end proc

proc SYSTEM_BUS_T.k_strtoupper(s as ubyte ptr) as ubyte ptr
    dim i as SYSTEM_TYPE
    dim dst as ubyte ptr=@(Result(0))
    i=0
    while s[i]<>0 and i<1022
        if (s[i]>=97 and s[i]<=122) then
            dst[i]=s[i]-32
        else
            dst[i]=s[i]
        end if
        i+=1
    wend
    dst[i]=0
    return dst
end proc

proc SYSTEM_BUS_T.k_strtolower(s as ubyte ptr) as ubyte ptr
    dim i as SYSTEM_TYPE
    dim dst as ubyte ptr=@(Result(0))
    i=0
    while s[i]<>0 and i<1022
        if (s[i]>=65 and s[i]<=90) then
            dst[i]=s[i]+32
        else
            dst[i]=s[i]
        end if
        i+=1
    wend
    dst[i]=0
    return dst
end proc

proc SYSTEM_BUS_T.k_substring(s as ubyte ptr,index as SYSTEM_TYPE, count as SYSTEM_TYPE) as ubyte ptr
    dim i as SYSTEM_TYPE
    dim dst as ubyte ptr=@(Result(0))
    dim l as SYSTEM_TYPE=k_strlen(s)
    i=0
    while s[i+index]<>0 and i+index<1022 and i+index<l  and (i<count or count=-1)
        dst[i]=s[i+index]
        i+=1
    wend
    dst[i]=0
    return dst
end proc

proc SYSTEM_BUS_T.k_strlastindexof(s as ubyte ptr,s2 as ubyte ptr) as SYSTEM_TYPE
    var l1=k_strlen(s)
    var l2=k_strlen(s2)
    dim i as SYSTEM_TYPE
    dim j as SYSTEM_TYPE
    var ok=0
    for i=l1-l2 to 0 step -1
        if s[i]=s2[0] then
            ok=1
            for j=0 to l2-1
                if s[i+j]<>s2[j] then 
                    ok=0
                    exit for
                end if
            next j
            if ok<>0 then return i
        end if
    next i
    return -1
end proc

proc SYSTEM_BUS_T.k_strendswith(src as ubyte ptr,search as ubyte ptr) as SYSTEM_TYPE
    if (k_strlastindexof(src,search) = k_strlen(src)-k_strlen(search)) then
        return 1
    else
        return 0
    end if
end proc
fatman2021
Posts: 215
Joined: Dec 14, 2013 0:43

Re: Project Manhattan

Post by fatman2021 »

Math Functions

Code: Select all

proc SYSTEM_BUS_T.k_f(x as float) as float
    return x*x
end proc

proc SYSTEM_BUS_T.k_frexp(d as float, ep as float ptr) as float

	static as Cheat x

	if(d = 0) then
		*ep = 0
		return 0
	end if
	x.d = d
	*ep = ((x.ms shr K_SHIFT) and K_MASK) - K_BIAS
	x.ms = x.ms and  not (K_MASK shl K_SHIFT)
	x.ms = x.ms or K_BIAS shl K_SHIFT
	return x.d
end proc

proc SYSTEM_BUS_T.k_ldexp(d as float, e as float) as float

	static as Cheat x

	if(d = 0) then
		return 0
	end if	
	x.d = d
	e += (x.ms shr K_SHIFT) and K_MASK
	if(e <= 0) then
		return 0	        /' underflow '/
    end if		
	if(e >= K_MASK) then	/' overflow '/
		if(d < 0) then
			return NEG_INF
		end if	
		return POS_INF
	end if
	x.ms = x.ms and  not (K_MASK shl K_SHIFT)
	x.ms = x.ms or e shl K_SHIFT
	return x.d
end proc

proc SYSTEM_BUS_T.k_sqrt(arg as float) as float
	static as float x, temp
	static as float _exp, i

	if(arg <= 0) then
		if(arg < 0) then
			return 0.0
	    end if		
		return 0
	end if
	x = k_frexp(arg, @_exp)
	while(x < 0.5)
		x *= 2
		_exp = _exp - 1
	wend
	/'
	 ' NOTE
	 ' this wont work on 1's comp
	 '/
	if(_exp and 1) then
		x *= 2
		_exp = _exp - 1
	end if
	temp = 0.5 * (1.0+x)

	while(_exp > 60)
		temp *= (1L shl 30)
		_exp -= 60
	wend
	
	while(_exp < -60)
		temp /= (1L shl 30)
		_exp += 60
	wend
	
	if(_exp >= 0) then
		temp *= 1L shl (_exp/2)
	else
		temp /= 1L shl (-_exp/2)
	end if	
	for i=0 to 4
		temp = 0.5*(temp + arg/temp)
	next	
	return temp
end proc
fatman2021
Posts: 215
Joined: Dec 14, 2013 0:43

Re: Project Manhattan

Post by fatman2021 »

qb64.bi updates

Code: Select all

#define ptrszint  int64
#define uptrszint uint64
#define ptrsz     8

' QB64 string descriptor structure
type qbs_field
    as int32 fileno
    as int64 fileid
    as int64 size
    as int64 offset
end type

type qbs 
    as uint8 ptr chr  ' a 32 bit pointer to the string's data
    as int32 len      ' must be signed for comparisons against signed int32s
    as uint8 in_mem64 ' set to 1 if in the conventional memory DBLOCK
    as uint16 ptr mem64_descriptor
    as uint16 mem64_descriptor_offset
    as uint32 listi     ' the index in the list of strings that references it
    as uint8 tmp        ' set to 1 if the string can be deleted immediately after being processed
    as uint32 tmplisti  ' the index in the list of strings that references it
    as uint8 fixed      ' fixed length string
    as uint8 readonly   ' set to 1 if string is read only
    as qbs_field ptr field
end type

type img_struct 
    as any ptr lock_offset
    as int64 lock_id
    as uint8 valid    ' 0,1 0=invalid
    as uint8 text    ' if set, surface is a text surface
    as uint8 console ' dummy surface to absorb unimplemented console functionality
    as uint16 width
    as uint16 height
    as uint8 bytes_per_pixel  ' 1,2,4
    as uint8 bits_per_pixel   ' 1,2,4,8,16(text),32
    as uint32 mask            ' 1,3,&HF,&HFF,&HFFFF,&HFFFFFFFF
    as uint16 compatible_mode ' 0,1,2,7,8,9,10,11,12,13,32,256
    as uint32 color
    as uint32 background_color
    as uint32 draw_color
    as uint32 font               ' 8,14,16,?
    as int16 top_row    ' VIEW PRINT settings, unique (as in QB) to each "page"
    as int16 bottom_row ' unique (as in QB) to each "page"
    as int16 cursor_x
    as int16 cursor_y  
    as uint8 cursor_show
    as uint8 cursor_firstvalue
    as uint8 cursor_lastvalue
    union
        as uint8 ptr offset
        as uint32 ptr offset32
    end union
    as uint32 flags
    as uint32 ptr pal
    as int32 transparent_color  '-1 means no color is transparent
    as uint8 alpha_disabled
    as uint8 holding_cursor
    as uint8 print_mode
    ' BEGIN apm ('active page migration')
    ' everything between apm points is migrated during active page changes
    ' note: apm data is only relevent to graphics modes
    as uint8 apm_p1
    as int32 view_x1
    as int32 view_y1
    as int32 view_x2
    as int32 view_y2
    as int32 view_offset_x
    as int32 view_offset_y
    as float x
    as float y
    as uint8 clipping_or_scaling
    as float scaling_x
    as float scaling_y
    as float scaling_offset_x
    as float scaling_offset_y
    as float window_x1
    as float window_y1
    as float window_x2
    as float window_y2
    as float draw_ta
    as float draw_scale
    as uint8 apm_p2
    ' END apm
end type

' img_struct flags
#define IMG_FREEPAL 1 ' free palette data before freeing image
#define IMG_SCREEN  2 ' img is linked to other screen pages
#define IMG_FREEMEM 4 ' if set, it means memory must be freed

' QB64 internal variable type flags (internally referenced by some functions)
#define ISSTRING             1073741824
#define ISFLOAT               536870912
#define ISUNSIGNED            268435456
#define ISPOINTER             134217728
#define ISFIXEDLENGTH          67108864 ' only set for strings with pointer flag
#define ISINCONVENTIONALMEMORY 33554432
#define ISOFFSETINBITS         16777216

type ontimer_struct 
    as uint8 allocated
    as uint32 id       ' the event ID to trigger (0=no event)
    as int64 pass      ' the value to pass to the triggered event (only applicable to ON ... CALL ...(x)
    as uint8 active    ' 0=OFF, 1=ON, 2=STOP
    as uint8 state     ' 0=untriggered,1=triggered
    as float seconds   ' how many seconds between events
    as float last_time ' the last time this event was triggered
end type

type onkey_struct 
    as uint32 id                 ' the event ID to trigger (0=no event)
    as int64 pass                ' the value to pass to the triggered event (only applicable to ON ... CALL ...(x)
    as uint8 active              ' 0=OFF, 1=ON, 2=STOP
    as uint8 state               ' 0=untriggered,1=triggered,2=in progress(TIMER only),2+=multiple events queued(KEY only)
    as uint32 keycode            ' 32-bit code, same as what _KEYHIT returns
    as uint32 keycode_alternate  ' an alternate keycode which may also trigger event
    as uint8 key_scancode
    as uint8 key_flags
    ' flags:
    ' 0 No keyboard flag, 1-3 Either Shift key, 4 Ctrl key, 8 Alt key,32 NumLock key,64 Caps Lock key, 128 Extended keys on a 101-key keyboard
    ' To specify multiple shift states, add the values together. For example, a value of 12 specifies that the user-defined key is used in combination with the
    ' Ctrl and Alt keys.
    as qbs ptr text
end type

type onstrig_struct 
    as uint32 id     ' the event ID to trigger (0=no event)
    as int64 pass    ' the value to pass to the triggered event (only applicable to ON ... CALL ...(x)
    as uint8 active  ' 0=OFF, 1=ON, 2=STOP
    as uint8 state   ' 0=untriggered,1=triggered,2=in progress(TIMER only),2+=multiple events queued(KEY only)
end type

type byte_element_struct
    as uint64 offset
    as int32 length
end type

type device_struct
    as int32 used
    as int32 type
    ' 0=Unallocated
    ' 1=Joystick/Gamepad
    ' 2=Keybaord
    ' 3=Mouse
    as char ptr name
    as int32 connected
    as int32 lastbutton
    as int32 lastaxis
    as int32 lastwheel
    '--------------
    as int32 max_events
    as int32 queued_events
    as uint8 ptr events ' the structure and size of the events depends greatly on the device and its capabilities
    as int32 event_size
    '--------------
    dim as uint8 STRIG_button_pressed(256) ' checked and cleared by the STRIG function
    '--------------
    as any ptr handle_pointer ' handle as pointer
    as int64 handle_int       ' handle as integer
    as char ptr description   ' description provided by manufacturer
    as int64 product_id
    as int64 vendor_id
    as int32 buttons
    as int32 axes
    as int32 balls
    as int32 hats
end type

' device_struct constants
#define QUEUED_EVENTS_LIMIT   1024
#define DEVICETYPE_CONTROLLER    1
#define DEVICETYPE_KEYBOARD      2
#define DEVICETYPE_MOUSE         3


type mem_block
    as ptrszint offset
    as ptrszint size
    as int64 lock_id        ' 64-bit key, must be present at lock's offset or memory region is invalid
    as ptrszint lock_offset ' pointer to lock
    as ptrszint type
    /'
        memorytype (4 bytes, but only the first used, for flags):
        1 integer values
        2 unsigned (set in conjunction with integer)
        4 floating point values
        8 char string(s) 'element-size is the memory size of 1 string
    '/
    as ptrszint elementsize
    as int32 image
    as int32 sound
end type

type mem_lock
    as uint64 id
    as int32 type ' required to know what action to take (if any) when a request is made to free the block
    ' 0=no security (eg. user defined block from _OFFSET)
    ' 1=C-malloc'ed block
    '  2=image
    ' 3=sub/function scope block
    ' 4=array
    '  5=sound
    ' ---- type specific variables follow ----
    as any ptr offset ' used by malloc'ed blocks to free them
end type

static shared as uint32 new_error = 0
static shared as uint32 error_err = 0
static shared as float  error_erl = 0
static shared as uint32 error_occurred = 0
static shared as uint32 error_goto_line = 0
static shared as uint32 error_handling = 0
static shared as uint32 error_retry = 0

' keyhit cyclic buffer
static shared as int64 keyhit(8192)
'    keyhit specific internal flags: (stored in high 32-bits)
'    &4294967296->numpad was used
static shared as int32 keyhit_nextfree
static shared as int32 keyhit_next
' note: if full, the oldest message is discarded to make way for the new message

static shared as uint8 port60h_event(256)
static shared as int32 port60h_events

static shared as int32 window_exists
static shared as int32 no_control_characters2

static shared as int32 disableEvents = 0

' shared global variables
static shared as int32 consolekey
static shared as int32 consolemousex
static shared as int32 consolemousey
static shared as int32 consolebutton

static shared as int32 sleep_break
static shared as uint64 mem_lock_id
static shared as mem_lock ptr mem_lock_tmp
static shared as int64 exit_code
static shared as int32 lock_mainloop ' 0=unlocked, 1=lock requested, 2=locked
static shared as int64 device_event_index
static shared as int32 exit_ok
static shared as qbs ptr func_command_str
static shared as int32 timer_event_occurred = 0 ' inc/dec as each GOSUB to QBMAIN ()
                                                ' begins/ends
static shared as int32 timer_event_id = 0
static shared as int32 key_event_occurred = 0 ' inc/dec as each GOSUB to QBMAIN () begins/ends
static shared as int32 key_event_id = 0
static shared as int32 strig_event_occurred = 0 ' inc/dec as each GOSUB to QBMAIN ()
                                                ' begins/ends
static shared as int32 strig_event_id = 0
static shared as uint32 ercl
static shared as uint32 inclercl
static shared as char ptr includedfilename
static shared as uint16 call_absolute_offsets(256)
static shared as uint32 dbgline
static shared as uint32 qbs_mem64_sp = 256
static shared as uint32 mem64_sp = 65536
static shared as ptrszint dblock ' 32bit offset of dblock
static shared as uint8 close_program = 0
static shared as int32 tab_spc_cr_size = 1 ' 1=PRINT(default), 2=FILE
static shared as int32 tab_fileno = 0      ' only valid if tab_spc_cr_size=2
static shared as int32 tab_LPRINT = 0      ' 1=dest is LPRINT image

static shared as uint64 ptr nothingvalue ' a pointer to 8 empty bytes in dblock
static shared as uint32 qbs_tmp_list_nexti = 1
static shared as uint32 bkp_new_error = 0
static shared as qbs ptr nothingstring
static shared as uint32 qbevent = 0
static shared as uint8 suspend_program = 0
static shared as uint8 stop_program = 0

static shared as SYSTEM_TYPE ptr mem64_static_pointer = @mem64(0) + 1280 + 65536
static shared as SYSTEM_TYPE ptr mem64_dynamic_base = @mem64(0) + 655360
static shared as SYSTEM_TYPE ptr mem_static
static shared as SYSTEM_TYPE ptr mem_static_pointer
static shared as SYSTEM_TYPE ptr mem_static_limit
static shared as float last_line = 0
static shared as uint32 next_return_point = 0
static shared as uint32 ptr return_point = 0: return_point = peek(uint32 ptr,malloc(4 * 16384))
static shared as uint32 return_points = 16384
static shared as any ptr qbs_input_variableoffsets(257)
static shared as int32 qbs_input_variabletypes(257)


' qbmain specific global variables
static shared as char g_tmp_char
static shared as uint8 g_tmp_uchar
static shared as int16 g_tmp_short
static shared as uint16 g_tmp_ushort
static shared as int32 g_tmp_long
static shared as uint32 g_tmp_ulong

static shared as int8 g_tmp_int8
static shared as uint8 g_tmp_uint8
static shared as int16 g_tmp_int16
static shared as uint16 g_tmp_uint16
static shared as int32 g_tmp_int32
static shared as uint32 g_tmp_uint32
static shared as int64 g_tmp_int64
static shared as uint64 g_tmp_uint64
static shared as float g_tmp_float
static shared as float g_tmp_double
static shared as float g_tmp_longdouble

static shared as qbs ptr g_tmp_str
static shared as qbs ptr g_swap_str
static shared as qbs ptr pass_str
static shared as ptrszint data_offset = 0
fatman2021
Posts: 215
Joined: Dec 14, 2013 0:43

Re: Project Manhattan

Post by fatman2021 »

bit-array access functions

Code: Select all

' bit-array access functions (note: used to be included through 'bit.cpp')
proc SYSTEM_BUS_T.getubits(bsize as uint32, _base as uint8 ptr, i as ptrszint) as uint64
    static as int64 bmask, n=1
    bmask = not (-((peek(int64,@n))) shl bsize)
    i *= bsize
    return ((*cptr(uint64 ptr,(_base + (i shr 3)))) shr (i and 7)) and bmask
end proc

proc SYSTEM_BUS_T.getbits(bsize as uint32, _base as uint8 ptr, i as ptrszint) as int64
    static as int64 bmask, bval64, n=1
    bmask = not (-((peek(int64,@n)) shl bsize))
    i *= bsize
    bval64 = ((*cptr(uint64 ptr,(_base + (i shr 3))) shr (i and 7))) and bmask
    if (bval64 and ((peek(int64,@n)) shl (bsize - 1))) then
        return bval64 or (not bmask)
    end if    
    return bval64
end proc

def  SYSTEM_BUS_T.setbits(bsize as uint32, _base as uint8 ptr, i as ptrszint, _val as int64)
    static as int64 bmask,n=1
    static as uint64 ptr bptr64
    bmask = ((peek(uint64,@n)) shl bsize) - 1
    i *= bsize
    bptr64 = peek(uint64 ptr,(_base + (i shr 3)))
    *bptr64 = (*cptr(uint64 ptr,bptr64) and (((bmask shl (i and 7)) xor -1))) or ((_val and bmask) shl (i and 7))
end def
fatman2021
Posts: 215
Joined: Dec 14, 2013 0:43

Re: Project Manhattan

Post by fatman2021 »

Updated floating point math support:

Code: Select all

' float128 math functions
/'
void float128_from_double(float128* a, double* b) {
    *a = (float128)(*(double*)(b));
}
'/
def SYSTEM_BUS_T.k_float128_from_double(a as FLOAT128 ptr, b as float ptr)
    *a = *b
end def
/'
void float128_to_double(float128* a, double* b) {
    *a = (double)(*(float128*)(b));
}
'/
def SYSTEM_BUS_T.k_float128_to_double(a as FLOAT128 ptr, b as float ptr)
    *b = *a
end def
/'
void float128_add(float128* a, float128* b, float128* c) {
    *c = *a + *b;
}
'/
def SYSTEM_BUS_T.k_float128_add(a as FLOAT128 ptr, b as FLOAT128 ptr, c as FLOAT128 ptr)
    *c = *a + *b
end def
/'
void float128_sub(float128* a, float128* b, float128* c) {
    *c = *a - *b;
}
'/
def SYSTEM_BUS_T.k_float128_sub(a as FLOAT128 ptr, b as FLOAT128 ptr, c as FLOAT128 ptr)
    *c = *a - *b
end def
/'
void float128_abs(float128* a, float128* b) {
    if (*a > 0) {
        *b = *a;
    } else {
        *b = -*a;
    }
}
'/  
def SYSTEM_BUS_T.k_float128_abs(a as FLOAT128 ptr, b as FLOAT128 ptr)
    if (*a > 0) then
        *b = *a
    else 
        *b = -*a
    end if
end def
/'
void float128_mul(float128* a, float128* b, float128* c) {
    *c = *a * *b;
}
'/
def SYSTEM_BUS_T.k_float128_mul(a as FLOAT128 ptr, b as FLOAT128 ptr, c as FLOAT128 ptr)
    *c = *a * *b
end def
/'
void float128_div(float128* a, float128* b, float128* c) {
    *c = *a / *b;
}
'/
def SYSTEM_BUS_T.k_float128_div(a as FLOAT128 ptr, b as FLOAT128 ptr, c as FLOAT128 ptr)
    *c = *a / *b
end def
/'
int float128_cmp(float128* a, float128* b) {
    if (*a > *b) {
        return 1;
    } else if (*a < *b) {
        return -1;
    } else {
        return 0;
    }
}
'/
proc SYSTEM_BUS_T.k_float128_cmp(a as FLOAT128 ptr, b as FLOAT128 ptr) as int_t
    if (*a > *b) then
        return 1
    elseif (*a < *b) then
        return -1
    else
        return 0
    endif
end proc

' float256 math functions
/'
void float256_from_double(float256* a, double* b) {
    *a = (float256)(*(double*)(b));
}
'/
def SYSTEM_BUS_T.k_float256_from_double(a as FLOAT256 ptr, b as float ptr)
    *a = *b
end def
/'
void float256_to_double(float256* a, double* b) {
    *a = (double)(*(float256*)(b));
}
'/
def SYSTEM_BUS_T.k_float256_to_double(a as FLOAT256 ptr, b as float ptr)
    *b = *a
end def
/'
void float256_add(float256* a, float256* b, float256* c) {
    *c = *a + *b;
}
'/
def SYSTEM_BUS_T.k_float256_add(a as FLOAT256 ptr, b as FLOAT256 ptr, c as FLOAT256 ptr)
    *c = *a + *b
end def
/'
void float256_sub(float256* a, float256* b, float256* c) {
    *c = *a - *b;
}
'/
def SYSTEM_BUS_T.k_float256_sub(a as FLOAT256 ptr, b as FLOAT256 ptr, c as FLOAT256 ptr)
    *c = *a - *b
end def
/'
void float256_abs(float256* a, float256* b) {
    if (*a > 0) {
        *b = *a;
    } else {
        *b = -*a;
    }
}
'/  
def SYSTEM_BUS_T.k_float256_abs(a as FLOAT256 ptr, b as FLOAT256 ptr)
    if (*a > 0) then
        *b = *a
    else 
        *b = -*a
    end if
end def
/'
void float256_mul(float256* a, float256* b, float256* c) {
    *c = *a * *b;
}
'/
def SYSTEM_BUS_T.k_float256_mul(a as FLOAT256 ptr, b as FLOAT256 ptr, c as FLOAT256 ptr)
    *c = *a * *b
end def
/'
void float256_div(float256* a, float256* b, float256* c) {
    *c = *a / *b;
}
'/
def SYSTEM_BUS_T.k_float256_div(a as FLOAT256 ptr, b as FLOAT256 ptr, c as FLOAT256 ptr)
    *c = *a / *b
end def
/'
int float256_cmp(float256* a, float256* b) {
    if (*a > *b) {
        return 1;
    } else if (*a < *b) {
        return -1;
    } else {
        return 0;
    }
}
'/
proc SYSTEM_BUS_T.k_float256_cmp(a as FLOAT256 ptr, b as FLOAT256 ptr) as int_t
    if (*a > *b) then
        return 1
    elseif (*a < *b) then
        return -1
    else
        return 0
    endif
end proc

' float512 math functions
/'
void float512_from_double(float512* a, double* b) {
    *a = (float512)(*(double*)(b));
}
'/
def SYSTEM_BUS_T.k_float512_from_double(a as FLOAT512 ptr, b as float ptr)
    *a = *b
end def
/'
void float512_to_double(float512* a, double* b) {
    *a = (double)(*(float512*)(b));
}
'/
def SYSTEM_BUS_T.k_float512_to_double(a as FLOAT512 ptr, b as float ptr)
    *b = *a
end def
/'
void float512_add(float512* a, float512* b, float512* c) {
    *c = *a + *b;
}
'/
def SYSTEM_BUS_T.k_float512_add(a as FLOAT512 ptr, b as FLOAT512 ptr, c as FLOAT512 ptr)
    *c = *a + *b
end def
/'
void float512_sub(float512* a, float512* b, float512* c) {
    *c = *a - *b;
}
'/
def SYSTEM_BUS_T.k_float512_sub(a as FLOAT512 ptr, b as FLOAT512 ptr, c as FLOAT512 ptr)
    *c = *a - *b
end def
/'
void float512_abs(float512* a, float512* b) {
    if (*a > 0) {
        *b = *a;
    } else {
        *b = -*a;
    }
}
'/  
def SYSTEM_BUS_T.k_float512_abs(a as FLOAT512 ptr, b as FLOAT512 ptr)
    if (*a > 0) then
        *b = *a
    else 
        *b = -*a
    end if
end def
/'
void float512_mul(float512* a, float512* b, float512* c) {
    *c = *a * *b;
}
'/
def SYSTEM_BUS_T.k_float512_mul(a as FLOAT512 ptr, b as FLOAT512 ptr, c as FLOAT512 ptr)
    *c = *a * *b
end def
/'
void float512_div(float512* a, float512* b, float512* c) {
    *c = *a / *b;
}
'/
def SYSTEM_BUS_T.k_float512_div(a as FLOAT512 ptr, b as FLOAT512 ptr, c as FLOAT512 ptr)
    *c = *a / *b
end def
/'
int float512_cmp(float512* a, float512* b) {
    if (*a > *b) {
        return 1;
    } else if (*a < *b) {
        return -1;
    } else {
        return 0;
    }
}
'/
proc SYSTEM_BUS_T.k_float512_cmp(a as FLOAT512 ptr, b as FLOAT512 ptr) as int_t
    if (*a > *b) then
        return 1
    elseif (*a < *b) then
        return -1
    else
        return 0
    endif
end proc
fatman2021
Posts: 215
Joined: Dec 14, 2013 0:43

Re: Project Manhattan

Post by fatman2021 »

Project Manhattan-related AI-generated images

Image

Image

Image

Image

Image

Image

Image
Post Reply